5 * Revision 1.2 1996/09/30 13:28:58 ravndal
6 * Medium name length checked
8 * Revision 1.1.1.1 1995/10/24 10:21:31 cernlib
12 #include "geant321/pilot.h"
13 *CMZ : 3.21/03 06/10/94 16.31.40 by S.Ravndal
17 C. ******************************************************************
19 C * Initialise material constants for all the physics *
20 C. * mechanisms used by GEANT *
22 C. * ==>Called by : <USER>, UGINIT *
23 C. * Author R.Brun ********* *
25 C. ******************************************************************
27 #include "geant321/gcbank.inc"
28 #include "geant321/gcphys.inc"
29 #include "geant321/gccuts.inc"
30 #include "geant321/gcflag.inc"
31 #include "geant321/gcjloc.inc"
32 #include "geant321/gclist.inc"
33 #include "geant321/gcmulo.inc"
34 #include "geant321/gctmed.inc"
35 #include "geant321/gcmate.inc"
36 #include "geant321/gcnum.inc"
37 #include "geant321/gconsp.inc"
38 #include "geant321/gctime.inc"
39 #include "geant321/gctrak.inc"
40 #include "geant321/gcunit.inc"
41 DIMENSION CUTS(10),UCUT(10),MECA(5,13)
42 EQUIVALENCE (CUTS(1),CUTGAM),(MECA(1,1),IPAIR)
43 CHARACTER*4 DNAME,KCUT(10)
47 C. ------------------------------------------------------------------
49 C Write RUN parameters, version numbers and CUTS
55 WRITE(CHMAIL,10200)GVERSN,IGDATE,IGTIME
59 WRITE(CHMAIL,10300)IDRUN
74 C Get the version number of the original INIT structure
78 * Set NUMOLD to 0 to force recalculation of
79 * pointers in the tracking routines
89 WRITE(CHMAIL,10700) DNAME,IQ(JRUNG+11),IQ(JRUNG+12), Q(JRUNG+
95 WRITE(CHMAIL,10700) DNAME,IQ(JRUNG+13),IQ(JRUNG+14), Q(JRUNG+
101 WRITE(CHMAIL,10700) DNAME,IQ(JRUNG+15),IQ(JRUNG+16), Q(JRUNG+
107 WRITE(CHMAIL,10700) DNAME,IQ(JRUNG+17),IQ(JRUNG+18), Q(JRUNG+
112 IF(NRNDM(1).EQ.0.AND.NRNDM(2).EQ.0) THEN
114 * The random number sequence has not been explicitely
115 * initialised via a data card. See whether we can initialise
116 * it with the words 19/20 of the JRUNG data structure.
117 IF(IQ(JRUNG+19).NE.0.OR.IQ(JRUNG+20).NE.0) THEN
118 NRNDM(1) = IQ(JRUNG+19)
119 NRNDM(2) = IQ(JRUNG+20)
120 CALL GRNDMQ(NRNDM(1), NRNDM(2), 0, 'S')
123 CALL GRNDMQ(IQ(JRUNG+19), IQ(JRUNG+20), 0, 'G')
124 WRITE(CHMAIL,10900) IQ(JRUNG+19), IQ(JRUNG+20)
132 C Create energy loss and cross-section banks
134 IF(NEKBIN.LE.0.OR.NEKBIN.GT.199)NEKBIN=90
135 IF(EKMIN.GE.EKMAX.OR.EKMIN.LE.0.)THEN
140 EKINV=1./LOG10(EKMAX/EKMIN)
141 EKBIN(1)=LOG10(EKMIN)
144 GEKB=1.-GEKA*EKBIN(1)
146 EL=EKBIN(1)+(I-1)/GEKA
151 IF(NMATE.LE.0)GO TO 999
152 IF(JMATE.LE.0)GO TO 999
153 IF(JTMED.LE.0)GO TO 999
155 IF(IQ(JTMED-1).LT.40) THEN
157 CALL MZPUSH(IXCONS,JTMED,0,NPUSH,'I')
163 * If Landau fluctuations activated, cancel delta rays
165 IF (KLOS .EQ. 0) Q(JTMED+15) = 0.
166 IF (KLOS .EQ. 2) THEN
172 * If Cerenkov generation is on, activate Light absorbtion unless
173 * explicitely switched off by the user
181 Q(JTMED+31)=MAX(Q(JTMED+31),0.)
183 * If BCUTE,BCUTM,DCUTE,DCUTM,PPCUTM not initialized (=BIG)
184 * Set them to CUTGAM,CUTGAM,CUTELE,CUTELE respectively
186 IF(Q(JTMED+ 6).GT.0.9*BIG)Q(JTMED+ 6)=Q(JTMED+1)
187 IF(Q(JTMED+ 7).GT.0.9*BIG)Q(JTMED+ 7)=Q(JTMED+1)
188 IF(Q(JTMED+ 8).GT.0.9*BIG)Q(JTMED+ 8)=Q(JTMED+2)
189 IF(Q(JTMED+ 9).GT.0.9*BIG)Q(JTMED+ 9)=Q(JTMED+2)
190 IF(Q(JTMED+10).GT.0.9*BIG)Q(JTMED+10)=0.010
191 IF(Q(JTMED+10).LT.4.*EMASS)Q(JTMED+10)=4.*EMASS
194 20 CALL GEVKEV(Q(JTMED+K),UCUT(K),KCUT(K))
205 WRITE(CHMAIL,11300) (UCUT(K),KCUT(K),K=1,3)
207 WRITE(CHMAIL,11400) (UCUT(K),KCUT(K),K=4,5)
209 WRITE(CHMAIL,11500) (UCUT(K),KCUT(K),K=6,7)
211 WRITE(CHMAIL,11600) (UCUT(K),KCUT(K),K=8,10)
213 WRITE(CHMAIL,11700) (Q(JTMED+K),K=11,13)
215 WRITE(CHMAIL,11800) (Q(JTMED+K),K=14,16)
217 IF(Q(JTMED+18).EQ.3.) THEN
223 WRITE(CHMAIL,11900) (Q(JTMED+K),K=17,19)
225 WRITE(CHMAIL,12000) (Q(JTMED+K),K=20,22)
227 WRITE(CHMAIL,12100) Q(JTMED+23),Q(JTMED+31),Q(JTMED+32)
229 WRITE(CHMAIL,12110) Q(JTMED+33)
244 * *** Here we clean up the old cross section tables if any
249 IF(LQ(JMA-J).NE.0.AND.J.NE.5) THEN
250 CALL MZDROP(IXCONS,LQ(JMA-J),'L')
256 * *** Call initialisation of the phtotelectric effect constants
260 IF(JTM.LE.0) GO TO 180
263 CALL MZPUSH(IXCONS,JTM,NL,0,'I')
266 * IF(IQ(JTM-1).LT.40) THEN
268 * CALL MZPUSH(IXCONS,JTM,0,NPUSH,'I')
279 IF (TMAXFD.LE.0..OR. (IGAUTO.NE.0.AND.TMAXFD.GT.20.)) THEN
286 WRITE(CHMAIL,12200)NMAT,ITM
291 C=====> Get material parameters
302 CALL MZBOOK(IXCONS,JTP,JTM,0,'TCUT',0,0,40,3,0)
307 Q(JTP+31)=Q(JTMED+31)
308 Q(JTP+32)=Q(JTMED+32)
309 Q(JTP+33)=Q(JTMED+33)
310 ELSEIF(IQ(JTP-1).LT.40) THEN
312 CALL MZPUSH(IXCONS,JTP,0,NPUSH,'I')
314 Q(JTP+31)=Q(JTMED+31)
315 Q(JTP+32)=Q(JTMED+32)
316 Q(JTP+33)=Q(JTMED+33)
319 C=====> decay and synch. rad. in vacuum
324 Q(JTP+20) = Q(JTMED+20)
326 Q(JTP+32) = Q(JTMED+32)
330 C=====> Get tracking medium parameters
333 IF(LQ(JTM).NE.0)JTP=LQ(JTM)
335 IF(IQ(JTP-1).LT.40) THEN
337 CALL MZPUSH(IXCONS,JTP,0,NPUSH,'I')
339 Q(JTP+31)=Q(JTMED+31)
340 Q(JTP+32)=Q(JTMED+32)
341 Q(JTP+33)=Q(JTMED+33)
344 IF (KLOS .EQ. 2) THEN
350 * If Cerenkov generation is on, activate Light absorbtion unless
351 * explicitely switched off by the user
359 Q(JTP+31)=MAX(Q(JTP+31),0.)
360 IF(Q(JTP+ 6).GT.0.9*BIG)Q(JTP+ 6)=Q(JTP+1)
361 IF(Q(JTP+ 7).GT.0.9*BIG)Q(JTP+ 7)=Q(JTP+1)
362 IF(Q(JTP+ 8).GT.0.9*BIG)Q(JTP+ 8)=Q(JTP+2)
363 IF(Q(JTP+ 9).GT.0.9*BIG)Q(JTP+ 9)=Q(JTP+2)
364 IF(Q(JTP+10).GT.0.9*BIG)Q(JTP+10)=0.010
365 IF(Q(JTP+10).LT.4.*EMASS)Q(JTP+10)=4.*EMASS
367 CALL UHTOC(IQ(JTM+1),4,CHTITL,20)
370 IF(CHTITL(LAST:LAST).EQ.'$') LAST=LAST-1
371 IF(LAST.LT.20) CHTITL(LAST+1:20)=' '
375 70 CALL GEVKEV(Q(JTP+K),UCUT(K),KCUT(K))
378 WRITE(CHMAIL,12300)ITM,CHTITL
382 WRITE(CHMAIL,11300) (UCUT(K),KCUT(K),K=1,3)
384 WRITE(CHMAIL,11400) (UCUT(K),KCUT(K),K=4,5)
386 WRITE(CHMAIL,11500) (UCUT(K),KCUT(K),K=6,7)
388 WRITE(CHMAIL,11600) (UCUT(K),KCUT(K),K=8,10)
390 WRITE(CHMAIL,11700) (Q(JTP+K),K=11,13)
392 WRITE(CHMAIL,11800) (Q(JTP+K),K=14,16)
394 IF(Q(JTP+18).EQ.3.) THEN
400 WRITE(CHMAIL,11900) (Q(JTP+K),K=17,19)
402 WRITE(CHMAIL,12000) (Q(JTP+K),K=20,22)
404 WRITE(CHMAIL,12100) Q(JTP+23),Q(JTP+31),Q(JTP+32)
406 WRITE(CHMAIL,12110) Q(JTP+33)
426 MECA(1,I)=Q(JTP+10+I)
434 IF(Q(JTP+I).LT.0.0000099)THEN
442 C Check consistency of different tracking media
443 C referencing the same material
445 DO 120 ITM2=ITM+1,NTMED
449 IF(NMAT2.EQ.NMAT)THEN
451 IF(LQ(JTM2).NE.0)JTP2=LQ(JTM2)
453 IF(JTP2.NE.JTMED)THEN
455 IF (KLOS .EQ. 2) THEN
460 IF(Q(JTP2+ 6).GT.0.9*BIG)Q(JTP2+ 6)=Q(JTP2+1)
461 IF(Q(JTP2+ 7).GT.0.9*BIG)Q(JTP2+ 7)=Q(JTP2+1)
462 IF(Q(JTP2+ 8).GT.0.9*BIG)Q(JTP2+ 8)=Q(JTP2+2)
463 IF(Q(JTP2+ 9).GT.0.9*BIG)Q(JTP2+ 9)=Q(JTP2+2)
464 IF(Q(JTP2+10).GT.0.9*BIG)Q(JTP2+10)=0.010
465 IF(Q(JTP2+10).LT.4.*EMASS)Q(JTP2+10)=4.*EMASS
468 IF(Q(JTP+I).NE.Q(JTP2+I))THEN
469 WRITE(CHMAIL,12600)NMAT
471 WRITE(CHMAIL,12700)ITM,ITM2
480 IF (DEEMAX.LT.0.) THEN
483 IF(RADL.GT.2.)DEEMAX=0.25-0.2/SQRT(RADL)
485 DEEMAX = 0.2/SQRT(RADL)
488 IF(OLDGVE.LT.3.15.OR.STEMAX.LE.0.) THEN
490 * Before version 3.15 there was no STEMAX, so we put it to BIG
497 * It can happen that several tracking media refer to the
498 * same material. In this case we do not fill the cross section
499 * tables more than once. But we still fill the banks of the
501 IF(LQ(JMA-1).NE.0) GOTO 160
504 CALL MZPUSH(IXCONS,JMA,NPUSH,0,'I')
509 * Energy loss and cross-section tables
511 CALL MZBOOK(IXCONS,LBANK,JMA, -1,'MAEL',0,0,2*NEK1,3,0)
512 CALL MZBOOK(IXCONS,LBANK,JMA, -2,'MAMU',0,0, NEK1,3,0)
514 CALL MZBOOK(IXCONS,LBANK,JMA, -1,'MAEL',0,0,3*NEK1,3,0)
515 CALL MZBOOK(IXCONS,LBANK,JMA, -2,'MAMU',0,0,2*NEK1,3,0)
517 CALL MZBOOK(IXCONS,LBANK,JMA, -3,'MAAL',0,0, NEK1,3,0)
518 CALL MZBOOK(IXCONS,JPROB,JMA, -4,'MAPR',0,0, 40,3,0)
519 CALL MZBOOK(IXCONS,JPHOT,JMA, -6,'MAPH',2,2, NEK1,3,0)
520 CALL MZBOOK(IXCONS,JANNI,JMA, -7,'MAAN',0,0, NEK1,3,0)
521 CALL MZBOOK(IXCONS,JCOMP,JMA, -8,'MACO',0,0, NEK1,3,0)
522 CALL MZBOOK(IXCONS,JBREM,JMA, -9,'MABR',0,0,3*NEK1,3,0)
523 CALL MZBOOK(IXCONS,JPAIR,JMA,-10,'MAPA',0,0,2*NEK1,3,0)
524 CALL MZBOOK(IXCONS,JDRAY,JMA,-11,'MADR',0,0,3*NEK1,3,0)
526 * *** Special case for heavy materials, photo-fission
527 IF(A.GE.230..AND.A.LE.240..AND.IPFIS.NE.0)THEN
528 CALL MZBOOK(IXCONS,JPFIS,JMA,-12,'MAPF',0,0,2*NEK1,3,0)
531 * *** Rayleigh effect
532 CALL MZBOOK(IXCONS,JRAYL,JMA,-13,'MARA',0,0,2*NEK1,3,0)
534 * *** Muon nuclear interactions
538 CALL MZBOOK(IXCONS,JMUNU,JMA,-14,'MAMN',0,0,NEK1,3,0)
542 CALL MZBOOK(IXCONS,LBANK,JMA,-15,'MASE',0,0,2*NEK1,3,0)
543 CALL MZBOOK(IXCONS,LBANK,JMA,-16,'MASM',0,0,2*NEK1,3,0)
545 * *** Special for photeffect
548 * *** coefficients for energy loss
549 CALL MZBOOK(IXCONS,LBANK,JMA,-17,'MACE',0,0,6*NEK1,3,0)
550 CALL MZBOOK(IXCONS,LBANK,JMA,-18,'MACM',0,0,6*NEK1,3,0)
552 * *** auxiliary tables for integration of dE/dx
555 DO 130 JWORK=1, NEKBIN*4
559 * *** Straggling for thin layers, if in effect
561 CALL MZBOOK(IXCONS,JTSTRA,JMA,-19,'MAST',2,2,1,3,0)
562 #if defined(CERNLIB_ASHO)
564 CALL MZBOOK(IXCONS,JTASHO,JMA,-20,'MASH',0,0,106,3,0)
571 IF(JB.NE.0)IQ(JB-5)=NMAT
578 * *** Fill above tables (energy losses,cross-sections,stopping ranges)
603 * Energy loss coefficients
606 * *** The table for the energy loss in thin gas layers if the tracking
607 * media is defined as such
611 #if defined(CERNLIB_ASHO)
618 * *** Multiple scattering,energy-loss and mag.field steps
620 IF(LQ(JTM-J).NE.0) THEN
621 CALL MZDROP(IXCONS,LQ(JTM-J),'L')
624 CALL MZBOOK(IXCONS,LBANK,JTM, -1,'MUEL',0,0,NEK1+2,3,0)
626 CALL MZBOOK(IXCONS,LBANK,JTM, -2,'MUMU',0,0,NEK1+2,3,0)
638 +'1************************************************************')
642 +' * G E A N T Version',F7.4,' DATE/TIME',I7,'/',
645 +' * R U N ',I5,10X,' *')
647 +' ************************************************************')
649 +' * Data structure Date Time GVERSN ZVERSN *')
651 +' * -------------- ---- ---- ------ ------ *')
652 10700 FORMAT(' *',11X,A,6X,I7,2X,I4,3X,F7.4,2X,F7.2,5X,'*')
654 +' *----------------------------------------------------------*')
655 10900 FORMAT(' * Random number seeds: ',3X,I10,3X,I10,6X,'*')
657 +' * -------------------- *')
659 +' * Standard TPAR for this run are *')
661 +' * ------------------------------ *')
663 +' * CUTGAM=',F6.2,A4,' CUTELE=',F6.2,A4,' CUTNEU=',F6.2,A4,1X,
666 +' * CUTHAD=',F6.2,A4,' CUTMUO=',F6.2,A4,20X,'*')
668 +' * BCUTE =',F6.2,A4,' BCUTM =',F6.2,A4,20X,'*')
670 +' * DCUTE =',F6.2,A4,' DCUTM =',F6.2,A4,' PPCUTM=',F6.2,A4,1X,
673 +' * IPAIR =',F10.0,' ICOMP =',F10.0,' IPHOT =',F10.0,1X,'*')
675 +' * IPFIS =',F10.0,' IDRAY =',F10.0,' IANNI =',F10.0,1X,'*')
677 +' * IBREM =',F10.0,' IHADR =',F10.0,' IMUNU =',F10.0,1X,'*')
679 +' * IDCAY =',F10.0,' ILOSS =',F10.0,' IMULS =',F10.0,1X,'*')
681 +' * IRAYL =',F10.0,' ILABS =',F10.0,' ISYNC =',F10.0,1X,'*')
683 +' * ISTRA =',F10.0, 39X, '*')
685 12200 FORMAT(' ***** GPHYSI error, Material Nr=',I3,
686 + ' referenced by Medium Nr=',I3)
688 +' * Special TPAR for TMED',I4,3X,A,5X,'*')
690 +' * ------------------------- *')
691 12500 FORMAT(' ***** GPHYSI error, CUTS must be',
692 + ' greater than 10 KeV *****')
693 12600 FORMAT(' ***** GPHYSI error for material nr ',I4)
694 12700 FORMAT(7X,'Tracking medium NR',I4,' and',I4,
695 +' have different parameters')
697 +' * IHADR=3 not supported any more. GHEISHA will handle *')
699 +' * hadronic interactions for the above tracking medium *')