*
* Jan 17, 2001 -rtj
* Fixed a typo in the setting of the flag ITCKOV (was ICKOV)
*
* $Id$
*
* $Log$
* Revision 1.1 2001/07/08 06:24:34 jonesrt
* First release of the Geant3 geometry package for Hall D based on hdds. -rtj
*
* Revision 1.1 2001/06/25 14:05:32 radphi
* Changes made by jonesrt@hector
* added gxphys.F to the regular distribution -rtj
*
* Revision 1.1.1.1 1995/10/24 10:21:50 cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ : 12/06/95 15.03.22 by S.Ravndal
*-- Author :
SUBROUTINE GXPHYS
C.
C. ******************************************************************
C. * *
C. * Physics parameters control commands *
C. * *
C. * Author: R.Brun ********** *
C. * *
C. ******************************************************************
C.
#include "geant321/gcbank.inc"
#include "geant321/gcphys.inc"
#include "geant321/gccuts.inc"
#include "geant321/gconsp.inc"
#include "geant321/gcunit.inc"
#include "geant321/gctrak.inc"
#include "geant321/gcmulo.inc"
#include "geant321/gctmed.inc"
DIMENSION UCUTS(10),ULCUTS(10)
EQUIVALENCE(UCUTS(1),CUTGAM)
DIMENSION MECA(5,13)
EQUIVALENCE (MECA(1,1),IPAIR)
CHARACTER*6 CUTNAM(10)
CHARACTER*4 CEN(10)
CHARACTER*32 CHPATL
CHARACTER*(*) CHNUMB
PARAMETER (CHNUMB='1234567890')
DATA CUTNAM/'CUTGAM','CUTELE','CUTNEU','CUTHAD','CUTMUO',
+ 'BCUTE' ,'BCUTM' ,'DCUTE' ,'DCUTM' ,'PPCUTM'/
C.
C. ------------------------------------------------------------------
C.
CALL KUPATL(CHPATL,NPAR)
*
IF(CHPATL.EQ.'ANNI')THEN
CALL KUGETI(IANNI)
*
ELSEIF(CHPATL.EQ.'AUTO')THEN
CALL KUGETI(IGAUTO)
*
ELSEIF(CHPATL.EQ.'BREM')THEN
CALL KUGETI(IBREM)
*
ELSEIF(CHPATL.EQ.'CKOV')THEN
CALL KUGETI(ITCKOV)
*
ELSEIF(CHPATL.EQ.'COMP')THEN
CALL KUGETI(ICOMP)
*
ELSEIF(CHPATL.EQ.'DCAY')THEN
CALL KUGETI(IDCAY)
*
ELSEIF(CHPATL.EQ.'DRAY')THEN
CALL KUGETI(IDRAY)
*
ELSEIF(CHPATL.EQ.'ERAN')THEN
CALL KUGETR(EKMIN)
CALL KUGETR(EKMAX)
CALL KUGETI(NEKBIN)
NEKBIN=MIN(NEKBIN,199)
*
ELSEIF(CHPATL.EQ.'HADR')THEN
CALL KUGETI(IHADR)
*
ELSEIF(CHPATL.EQ.'LABS')THEN
CALL KUGETI(ILABS)
*
ELSEIF(CHPATL.EQ.'LOSS')THEN
CALL KUGETI(ILOSS)
IF(ILOSS.EQ.2.OR.ILOSS.EQ.0)THEN
IDRAY=0
ELSE
IDRAY=1
ENDIF
*
ELSEIF(CHPATL.EQ.'MULS')THEN
CALL KUGETI(IMULS)
*
ELSEIF(CHPATL.EQ.'MUNU')THEN
CALL KUGETI(IMUNU)
*
ELSEIF(CHPATL.EQ.'PAIR')THEN
CALL KUGETI(IPAIR)
*
ELSEIF(CHPATL.EQ.'PFIS')THEN
CALL KUGETI(IPFIS)
*
ELSEIF(CHPATL.EQ.'PHOT')THEN
CALL KUGETI(IPHOT)
*
ELSEIF(CHPATL.EQ.'RAYL')THEN
CALL KUGETI(IRAYL)
*
ELSEIF(CHPATL.EQ.'STRA')THEN
CALL KUGETI(ISTRA)
*
ELSEIF(CHPATL.EQ.'SYNC')THEN
CALL KUGETI(ISYNC)
*
ELSEIF(CHPATL.EQ.'CUTS')THEN
IF(NPAR.LE.0)THEN
WRITE(LOUT,10000)
10000 FORMAT(/,' Current PHYSICS parameters:',/)
DO 10 I=1,10
CALL GEVKEV(UCUTS(I),ULCUTS(I),CEN(I))
WRITE(LOUT,10100)CUTNAM(I),ULCUTS(I),CEN(I)
10100 FORMAT(5X,A,' = ',F7.2,1X,A)
10 CONTINUE
GO TO 999
ENDIF
CALL KUGETR(CUTGAM)
CALL KUGETR(CUTELE)
CALL KUGETR(CUTHAD)
CALL KUGETR(CUTNEU)
CALL KUGETR(CUTMUO)
CALL KUGETR(BCUTE)
CALL KUGETR(BCUTM)
CALL KUGETR(DCUTE)
CALL KUGETR(DCUTM)
CALL KUGETR(PPCUTM)
CALL KUGETR(TOFMAX)
CALL KUGETR(GCUTS(1))
IF(BCUTE.LE.0.)BCUTE=CUTGAM
IF(BCUTM.LE.0.)BCUTM=CUTGAM
IF(DCUTE.LE.0.)DCUTE=CUTELE
IF(DCUTM.LE.0.)DCUTM=CUTELE
IF(PPCUTM.LT.4.*EMASS)PPCUTM=4.*EMASS
*
ELSEIF(CHPATL.EQ.'DRPRT')THEN
CALL KUGETI(IPART)
CALL KUGETI(IMATE)
CALL KUGETR(STEP)
CALL KUGETI(NPOINT)
CALL GDRPRT(IPART,IMATE,STEP,NPOINT)
*
ELSEIF(CHPATL.EQ.'PHYSI')THEN
IF(JTMED.GT.0)THEN
DO 30 I=1,IQ(JTMED-2)
JTM=LQ(JTMED-I)
IF(JTM.LE.0)GO TO 30
IF(IQ(JTM-2).EQ.0)THEN
CALL MZPUSH(IXCONS,JTM,10,0,'I')
GO TO 30
ENDIF
DO 20 J=1,10
JTMI=LQ(JTM-J)
IF(JTMI.GT.0)THEN
CALL MZDROP(IXCONS,JTMI,' ')
ENDIF
20 CONTINUE
30 CONTINUE
CALL UCOPY(CUTGAM,Q(JTMED+1),10)
DO 40 I=1,13
Q(JTMED+10+I)=MECA(1,I)
40 CONTINUE
ENDIF
IF(JMATE.LE.0)GO TO 999
DO 60 I=1,IQ(JMATE-2)
JMA=LQ(JMATE-I)
IF(JMA.LE.0)GO TO 60
DO 50 J=1,IQ(JMA-2)
IF(J.EQ.4.OR.J.EQ.5)GO TO 60
JM=LQ(JMA-J)
IF(JM.LE.0)GO TO 50
CALL MZDROP(IXCONS,JM,'L')
50 CONTINUE
60 CONTINUE
CALL MZGARB (IXCONS, 0)
CALL GPHYSI
ENDIF
*
999 END