* * $Id: eudtit.F,v 1.1.1.1 1996/03/08 16:58:50 mclareni Exp $ * * $Log: eudtit.F,v $ * Revision 1.1.1.1 1996/03/08 16:58:50 mclareni * Eurodec * * #include "eurodec/pilot.h" SUBROUTINE EUDTIT C.---------------------------------------------------------------------- C. C. THIS SUBROUTINE READS AND PRINTS USER MODIFICATIONS SPECIFIED C. IN TITLE FILE WITH LOGICAL NAME 'EUDTIT' AT LUN1. LINES STARTING C. WITH '!' ARE DISCARDED. POSSIBLE INPUT DATA CARDS ARE: C. C. PARTICLE PROPERTIES/NAME=......../STABLE C. PARTICLE PROPERTIES/NAME=......../MASS=........ C. PARTICLE PROPERTIES/NAME=......../LIFETIME=........ C. PARTICLE PROPERTIES/NAME=......../WIDTH=........ C PARTICLE PROPERTIES/NAME=......../FORCE DECAY: C. /......../........,WHERE ........ IS A PARTICLE NAME (CHARACTER*8) C. WEAK MIXING/NAME=......../VALUE=........ C. FRAGMENTATION PARAMETER/NAME=......../VALUE=........, WHERE NAME C MAY BE GLUON, UP, DOWN, STRANGE, CHARM, BOTTOM, TOP, LOW, HIGH. C. VACUUM EXPECTATION/NAME=......../VALUE=........ C. WHERE NAME MAY BE STRANGE ,US ,SS ,CHARM C. WEINBERG ANGLE/VALUE=........ C. FRAGMENTATION HEAVY DECAYS/........ ,WHERE ........ IS ON OR OFF C. MESON PROBABILITY/VALUE=........ C. LIGHT PSEUDOSCALAR PROBABILITY/VALUE=........ C. HEAVY PSEUDOSCALAR PROBABILITY/VALUE=........ C. STABLE PARTICLE LIFETIME/VALUE=........ C. QUARK DEPOLARIZATION/VALUE=........ C. DEFAULT DECAY RATIOS/........ ,WHERE ........ IS ON OR OFF C. QCD PARTON SHOWER/........ ,WHERE ........ IS ON OR OFF C. PARTICLE MASS SMEARING/........ ,WHERE ........ IS ON OR OFF C. ONIUM POTENTIAL/........ ,WHERE ........ IS C. RICHARDSON OR QCD C. PRIMARY VERTEX/X-WIDTH=......../Y-WIDTH=......../Z-WIDTH=........ C. WHERE ........ IS WIDTH OF GAUSSIAN DISTRIBUTION (X ALONG BEAM!) C. SECONDARY VERTICES/........ ,WHERE ........ IS ON OR OFF C. RANDOM SEED/SEED1=......../SEED2=........ C. LAST UPDATE: 14/08/89 C. C.---------------------------------------------------------------------- #if defined(CERNLIB_DOUBLE) DOUBLE PRECISION YLQU,YHVY #endif #include "eurodec/eudopt.inc" #include "eurodec/inpout.inc" #include "eurodec/ptable.inc" #include "eurodec/dtable.inc" #include "eurodec/dforce.inc" #include "eurodec/wekpar.inc" #include "eurodec/epsfrg.inc" #include "eurodec/inivtx.inc" #include "eurodec/frgfix.inc" #include "eurodec/quafix.inc" #include "eurodec/ratmix.inc" #include "eurodec/filnam.inc" #include "eurodec/rnseed.inc" #include "eurodec/onipot.inc" CHARACTER*80 STRING,STRBUF CHARACTER*8 PNAME,PNADEC(6) LOGICAL OPENED DATA CHBAR/ 6.582173E-25/ C-- C-- OPEN EXTERNAL TITLE FILE IOS=0 INQUIRE(UNIT=LUN1, OPENED=OPENED) IF(.NOT.OPENED) THEN #if (defined(CERNLIB_VAX)||defined(CERNLIB_IBM)||defined(CERNLIB_UNIX)||defined(CERNLIB_CDC))&&(!defined(CERNLIB_APOLLO))&&(!defined(CERNLIB_MACMPW)) OPEN (UNIT=LUN1,STATUS='OLD',IOSTAT=IOS) #endif #if defined(CERNLIB_APOLLO)||defined(CERNLIB_MACMPW) OPEN (UNIT=LUN1,FILE=EUTITD,STATUS='OLD',IOSTAT=IOS) #endif IF (IOS.NE.0) CALL ERRORD(58,'Titles',0.) END IF WRITE(LUN2,9000) WRITE(LUN2,9010) C-- C-- SKIP TRAILER RECORDS ISKIP=1 I=0 C-- C-- READ TITLES, SKIP COMMENTS 10 I=I+1 READ(LUN1,'(A)',ERR=110,END=120) STRING IF (ISKIP.EQ.0) WRITE(LUN2,9020) STRING C-- C-- SCAN DATA STRING AND DETERMINE LENGTH IF (STRING(1:1).EQ.'!') GOTO 10 IF (ISKIP.EQ.1) WRITE(LUN2,9020) STRING ISKIP=0 IF (STRING(1:7).EQ.'ENDLIST') GOTO 130 LENGTH=INDEX(STRING(1:80),'!')-1 IF (LENGTH.EQ.-1) LENGTH=80 C-- C-- SCAN ON KEY WORDS INDX1=INDEX(STRING(1:LENGTH),'/')-1 IF (INDX1.EQ.-1) CALL ERRORD(72,' ',FLOAT(I)) IF (STRING(1:INDX1).EQ.'PARTICLE PROPERTIES') THEN IF (STRING(INDX1+2:INDX1+6).NE.'NAME=') CALL ERRORD(73,STRING(IN & DX1+2:INDX1+6),FLOAT(I)) INDX1=INDX1+7 INDX2=INDEX(STRING(INDX1:LENGTH),'/')-2+INDX1 IF ((INDX2-INDX1).NE.7) CALL ERRORD(74,STRING(INDX1:INDX1+7),FLO & AT(I)) PNAME=STRING(INDX1:INDX2) IP1=NAMPOI(PNAME) IFORCE=0 20 INDX1=INDX2+2 IF (INDX1.LT.LENGTH) THEN INDX2=INDEX(STRING(INDX1:LENGTH),'/')-2+INDX1 IF (INDX2.EQ.INDX1-2) INDX2=LENGTH IF (STRING(INDX1:INDX1+5).EQ.'STABLE') THEN IF (IDP(IP1).GT.0) IDP(IP1)=-IDP(IP1) ELSEIF (STRING(INDX1:INDX1+4).EQ.'MASS=') THEN STRBUF=STRING(INDX1+5:INDX2) READ(STRBUF,'(BN,F80.0)',IOSTAT=IOS) PM(IP1) IF (PM(IP1).LT.0.0) CALL ERRORD(81,PNAME,FLOAT(I)) ELSEIF (STRING(INDX1:INDX1+8).EQ.'LIFETIME=') THEN STRBUF=STRING(INDX1+9:INDX2) READ(STRBUF,'(BN,E80.0)',IOSTAT=IOS) PLT(IP1) IF (PLT(IP1).LT.0.0) CALL ERRORD(82,PNAME,FLOAT(I)) ELSEIF (STRING(INDX1:INDX1+5).EQ.'WIDTH=') THEN STRBUF=STRING(INDX1+6:INDX2) READ(STRBUF,'(BN,F80.0)',IOSTAT=IOS) WIDTH IF (WIDTH.LE.0.0) CALL ERRORD(83,PNAME,FLOAT(I)) PLT(IP1)=CHBAR/WIDTH ELSEIF (STRING(INDX1:INDX1+11).EQ.'FORCE DECAY:') THEN IFORCE=1 ELSE CALL ERRORD(73,STRING(INDX1:INDX1+11),FLOAT(I)) ENDIF IF (IOS.NE.0) CALL ERRORD(76,' ',FLOAT(I)) GOTO 20 ELSE IF (IFORCE.EQ.1) THEN C-- C-- READ NEXT RECORD FOR DECAY PARTICLES 30 READ(LUN1,'(A)',ERR=110,END=120) STRING WRITE(LUN2,9020) STRING I=I+1 IF (STRING(1:1).EQ.'!') GOTO 30 LENGTH=INDEX(STRING(1:80),'!')-1 IF (LENGTH.EQ.-1) LENGTH=80 IF (STRING(1:1).NE.'/') CALL ERRORD(77,' ',FLOAT(I)) ISGN=1 C-- C-- FLIP SIGN FOR CHARGE CONJUGATE OF PARTICLE IN PARTICLE TABLE IF (PNAME(8:8).NE.PNA(IP1)(8:8)) ISGN=-1 INDX1=2 J=0 40 J=J+1 INDX2=INDX1+7 PNADEC(J)=STRING(INDX1:INDX2) INDX1=INDEX(STRING(INDX2:LENGTH),'/')+INDX2 IF (INDX1.NE.INDX2) GOTO 40 C-- C-- FIND DECAY POINTER... IP3=ABS(IDP(IP1))-1 50 IP3=IP3+1 IF (IP3.GT.NDMAX) CALL ERRORD(78,' ',FLOAT(I)) DO 60 K=1,J IP2=NAMPOI(PNADEC(K)) IF (IPC(IP2).NE.IABS(IDC(K,IP3))) GOTO 50 60 CONTINUE C-- C-- ...DECAY POINTER FOUND, CHECK PARTICLE CHARGE DO 70 K=1,J IP2=NAMPOI(PNADEC(K)) C-- C-- FLIP SIGN FOR CHARGE CONJUGATE OF PARTICLE IN PARTICLE TABLE IF (PNADEC(K)(8:8).EQ.PNA(IP2)(8:8)) THEN ISGND=1 C-- C-- SPECIAL CASE: GAMMA, H0, Z0, KS, KL AND MESONS/ONIA WITH Q = QBAR ICO=IPC(IP2) IMES=0 IF ((ABS(ICO).GE.110).AND.(ABS(ICO).LT.1000)) THEN ICO1=ABS(ICO)/100 ICO2=(ABS(ICO)-ICO1*100)/10 IF (ICO1.EQ.ICO2) IMES=1 ENDIF IF ((ICO.EQ.99).OR.(ICO.EQ.191).OR.(ICO.EQ.199).OR.(ICO. & EQ.328).OR.(ICO.EQ.329).OR.(IMES.EQ.1)) ISGND=ISGND*ISGN ELSE ISGND=-1 ENDIF IF ((ISGN*ISGND*IPC(IP2)).NE.IDC(K,IP3)) CALL ERRORD(79, & PNADEC(K),FLOAT(I)) 70 CONTINUE IF (ISGN.EQ.1) THEN IFRCP(IP1)=IP3 ELSE IFRCM(IP1)=IP3 ENDIF ENDIF ENDIF ELSEIF (STRING(1:INDX1).EQ.'WEAK MIXING') THEN IF (STRING(INDX1+2:INDX1+6).NE.'NAME=') CALL ERRORD(73,STRING( & INDX1+2:INDX1+6),FLOAT(I)) INDX1=INDX1+7 INDX2=INDEX(STRING(INDX1:LENGTH),'/')-2+INDX1 IF ((INDX2-INDX1).NE.7) CALL ERRORD(74,STRING(INDX1:INDX1+7),F & LOAT(I)) PNAME=STRING(INDX1:INDX2) INDX1=INDX2+2 IF (STRING(INDX1:INDX1+5).NE.'VALUE=') CALL ERRORD(73,STRING(IND & X1:INDX1+5),FLOAT(I)) STRBUF=STRING(INDX1+6:LENGTH) READ(STRBUF,'(BN,F80.0)',IOSTAT=IOS) VALUE IF (PNAME(1:3).EQ.'D0 ') THEN RD0MIX=VALUE ELSEIF (PNAME(1:3).EQ.'B0 ') THEN RBDMIX=VALUE ELSEIF (PNAME(1:3).EQ.'BS0') THEN RBSMIX=VALUE ELSE CALL ERRORD(75,PNAME,FLOAT(I)) ENDIF ELSEIF (STRING(1:INDX1).EQ.'FRAGMENTATION PARAMETER') THEN IF (STRING(INDX1+2:INDX1+6).NE.'NAME=') CALL ERRORD(73,STRING(IN & DX1+2:INDX1+6),FLOAT(I)) INDX1=INDX1+7 INDX2=INDEX(STRING(INDX1:LENGTH),'/')-2+INDX1 IF ((INDX2-INDX1).NE.7) CALL ERRORD(74,STRING(INDX1:INDX1+7),FLO & AT(I)) PNAME=STRING(INDX1:INDX2) INDX1=INDX2+2 IF (STRING(INDX1:INDX1+5).NE.'VALUE=') CALL ERRORD(73,STRING(IND & X1:INDX1+5),FLOAT(I)) STRBUF=STRING(INDX1+6:LENGTH) READ(STRBUF,'(BN,F80.0)',IOSTAT=IOS) VALUE IF ((PNAME.EQ.'UP ').OR.(PNAME.EQ.'DOWN ').OR.(PNAME & .EQ.'STRANGE ')) THEN EPSLQU=VALUE ELSEIF (PNAME.EQ.'GLUON ') THEN EPSGLU=VALUE ELSEIF (PNAME.EQ.'CHARM ') THEN EPSHVY(1)=VALUE ELSEIF (PNAME.EQ.'BOTTOM ') THEN EPSHVY(2)=VALUE ELSEIF (PNAME.EQ.'TOP ') THEN EPSHVY(3)=VALUE ELSEIF (PNAME.EQ.'LOW ') THEN EPSHVY(4)=VALUE ELSEIF (PNAME.EQ.'HIGH ') THEN EPSHVY(5)=VALUE ELSE CALL ERRORD(74,PNAME,FLOAT(I)) ENDIF ELSEIF (STRING(1:INDX1).EQ.'VACUUM EXPECTATION') THEN IF (STRING(INDX1+2:INDX1+6).NE.'NAME=') CALL ERRORD(73,STRING(IN & DX1+2:INDX1+6),FLOAT(I)) INDX1=INDX1+7 INDX2=INDEX(STRING(INDX1:LENGTH),'/')-2+INDX1 IF ((INDX2-INDX1).NE.7) CALL ERRORD(74,STRING(INDX1:INDX1+7),FLO & AT(I)) PNAME=STRING(INDX1:INDX2) INDX1=INDX2+2 IF (STRING(INDX1:INDX1+5).NE.'VALUE=') CALL ERRORD(73,STRING(IND & X1:INDX1+5),FLOAT(I)) STRBUF=STRING(INDX1+6:LENGTH) READ(STRBUF,'(BN,F80.0)',IOSTAT=IOS) VALUE IF (PNAME.EQ.'STRANGE ') THEN PROS=VALUE ELSEIF (PNAME.EQ.'US ') THEN PROUS=VALUE ELSEIF (PNAME.EQ.'SS ') THEN PROSS=VALUE ELSEIF (PNAME.EQ.'CHARM ') THEN PROCC=VALUE ELSE CALL ERRORD(74,PNAME,FLOAT(I)) ENDIF ELSEIF (STRING(1:INDX1).EQ.'WEINBERG ANGLE') THEN IF (STRING(INDX1+2:INDX1+7).NE.'VALUE=') CALL ERRORD(73,STRING & (INDX1+2:INDX1+7),FLOAT(I)) STRBUF=STRING(INDX1+8:LENGTH) READ(STRBUF,'(BN,F80.0)',IOSTAT=IOS) XW ELSEIF (STRING(1:INDX1).EQ.'MESON PROBABILITY') THEN IF (STRING(INDX1+2:INDX1+7).NE.'VALUE=') CALL ERRORD(73,STRING & (INDX1+2:INDX1+7),FLOAT(I)) STRBUF=STRING(INDX1+8:LENGTH) READ(STRBUF,'(BN,F80.0)',IOSTAT=IOS) PROMES ELSEIF (STRING(1:INDX1).EQ.'FRAGMENTATION HEAVY DECAYS') THEN IF (STRING(INDX1+2:INDX1+3).EQ.'ON') THEN IHVYFR=1 ELSEIF (STRING(INDX1+2:INDX1+4).EQ.'OFF') THEN IHVYFR=0 ELSE CALL ERRORD(73,STRING(INDX1+2:INDX1+4),FLOAT(I)) ENDIF ELSEIF (STRING(1:INDX1).EQ.'LIGHT PSEUDOSCALAR PROBABILITY') THEN IF (STRING(INDX1+2:INDX1+7).NE.'VALUE=') CALL ERRORD(73,STRING & (INDX1+2:INDX1+7),FLOAT(I)) STRBUF=STRING(INDX1+8:LENGTH) READ(STRBUF,'(BN,F80.0)',IOSTAT=IOS) PROPSE(1) ELSEIF (STRING(1:INDX1).EQ.'HEAVY PSEUDOSCALAR PROBABILITY') THEN IF (STRING(INDX1+2:INDX1+7).NE.'VALUE=') CALL ERRORD(73,STRING & (INDX1+2:INDX1+7),FLOAT(I)) STRBUF=STRING(INDX1+8:LENGTH) READ(STRBUF,'(BN,F80.0)',IOSTAT=IOS) PROPSE(2) ELSEIF (STRING(1:INDX1).EQ.'STABLE PARTICLE LIFETIME') THEN IF (STRING(INDX1+2:INDX1+7).NE.'VALUE=') CALL ERRORD(73,STRING & (INDX1+2:INDX1+7),FLOAT(I)) STRBUF=STRING(INDX1+8:LENGTH) READ(STRBUF,'(BN,E80.0)',IOSTAT=IOS) PLIFET ELSEIF (STRING(1:INDX1).EQ.'QUARK DEPOLARIZATION') THEN IF (STRING(INDX1+2:INDX1+7).NE.'VALUE=') CALL ERRORD(73,STRING & (INDX1+2:INDX1+7),FLOAT(I)) STRBUF=STRING(INDX1+8:LENGTH) READ(STRBUF,'(BN,F80.0)',IOSTAT=IOS) QDEPOL ELSEIF (STRING(1:INDX1).EQ.'DEFAULT DECAY RATIOS') THEN 80 IF (STRING(INDX1+2:INDX1+3).EQ.'ON') THEN IDEFDC=1 ELSEIF (STRING(INDX1+2:INDX1+4).EQ.'OFF') THEN IDEFDC=0 ELSEIF (STRING(INDX1+2:INDX1+6).EQ.'PRINT') THEN IBRDMP=1 ELSEIF (STRING(INDX1+2:INDX1+8).EQ.'NOPRINT') THEN IBRDMP=0 ELSE CALL ERRORD(73,STRING(INDX1+2:INDX1+4),FLOAT(I)) ENDIF INDX2=INDX1+2 INDX1=INDEX(STRING(INDX2:LENGTH),'/')+INDX2-2 IF (INDX1.NE.(INDX2-2)) GOTO 80 ELSEIF (STRING(1:INDX1).EQ.'QCD PARTON SHOWER') THEN IF (STRING(INDX1+2:INDX1+3).EQ.'ON') THEN ICASC=1 ELSEIF (STRING(INDX1+2:INDX1+4).EQ.'OFF') THEN ICASC=0 ELSE CALL ERRORD(73,STRING(INDX1+2:INDX1+4),FLOAT(I)) ENDIF ELSEIF (STRING(1:INDX1).EQ.'PARTICLE MASS SMEARING') THEN IF (STRING(INDX1+2:INDX1+3).EQ.'ON') THEN MSMEAR=1 ELSEIF (STRING(INDX1+2:INDX1+4).EQ.'OFF') THEN MSMEAR=0 ELSE CALL ERRORD(73,STRING(INDX1+2:INDX1+4),FLOAT(I)) ENDIF ELSEIF (STRING(1:INDX1).EQ.'ONIUM POTENTIAL') THEN IF (STRING(INDX1+2:INDX1+11).EQ.'RICHARDSON') THEN IONIPT=0 ELSEIF (STRING(INDX1+2:INDX1+4).EQ.'QCD') THEN IONIPT=1 ELSE CALL ERRORD(73,STRING(INDX1+2:INDX1+4),FLOAT(I)) ENDIF ELSEIF (STRING(1:INDX1).EQ.'PRIMARY VERTEX') THEN 90 INDX1=INDX1+2 INDX2=INDEX(STRING(INDX1:LENGTH),'/')-2+INDX1 IF (INDX2.EQ.INDX1-2) INDX2=LENGTH IF (STRING(INDX1:INDX1+7).EQ.'X-WIDTH=') THEN STRBUF=STRING(INDX1+8:INDX2) READ(STRBUF,'(BN,F80.0)',IOSTAT=IOS) VTXSIG(1) IF (VTXSIG(1).LT.0.0) CALL ERRORD(74,'X-WIDTH',VTXSIG(1)) ELSEIF (STRING(INDX1:INDX1+7).EQ.'Y-WIDTH=') THEN STRBUF=STRING(INDX1+8:INDX2) READ(STRBUF,'(BN,F80.0)',IOSTAT=IOS) VTXSIG(2) IF (VTXSIG(2).LT.0.0) CALL ERRORD(74,'Y-WIDTH',VTXSIG(2)) ELSEIF (STRING(INDX1:INDX1+7).EQ.'Z-WIDTH=') THEN STRBUF=STRING(INDX1+8:INDX2) READ(STRBUF,'(BN,F80.0)',IOSTAT=IOS) VTXSIG(3) IF (VTXSIG(3).LT.0.0) CALL ERRORD(74,'Z-WIDTH',VTXSIG(1)) ELSE CALL ERRORD(73,STRING(INDX1:INDX1+7),FLOAT(I)) ENDIF IF (IOS.NE.0) CALL ERRORD(76,' ',FLOAT(I)) INDX1=INDX2 IF (INDX1.LT.LENGTH) GOTO 90 ELSEIF (STRING(1:INDX1).EQ.'SECONDARY VERTICES') THEN IF (STRING(INDX1+2:INDX1+3).EQ.'ON') THEN ISVTX=1 ELSEIF (STRING(INDX1+2:INDX1+4).EQ.'OFF') THEN ISVTX=0 ELSE CALL ERRORD(73,STRING(INDX1+2:INDX1+4),FLOAT(I)) ENDIF C-- C-- SEEDS FOR RANDOM NUMBER GENERATOR ELSEIF (STRING(1:11).EQ.'RANDOM SEED') THEN 100 INDX2=INDX1+2 IF (INDX2.LT.LENGTH) THEN IF ((STRING(INDX2:INDX2+5).NE.'SEED1=').AND.(STRING(INDX2: & INDX2+5).NE.'SEED2=')) CALL ERRORD(73,STRING(INDX2:INDX2+5 & ),FLOAT(I)) IF (STRING(INDX2+4:INDX2+4).EQ.'1') THEN ISD=1 ELSE ISD=2 ENDIF INDX2=INDX2+6 INDX1=INDEX(STRING(INDX2:LENGTH),'/')-2+INDX2 IF (INDX1.EQ.INDX2-2) INDX1=LENGTH STRBUF=STRING(INDX2:INDX1) READ(STRBUF,'(BN,I80)',IOSTAT=IOS) ISEED(ISD) IF (IOS.NE.0) CALL ERRORD(76,' ',FLOAT(I)) GOTO 100 ENDIF ELSE C-- C-- UNIDENTIFIED KEYWORD... CALL ERRORD(71,STRING(1:INDX1),FLOAT(I)) ENDIF IF (IOS.NE.0) CALL ERRORD(76,' ',FLOAT(I)) GOTO 10 110 CALL ERRORD(51,' ',FLOAT(I)) 120 CALL ERRORD(52,' ',FLOAT(I)) C-- C-- END ON TITLE FILE REACHED 130 CLOSE (UNIT=LUN1) RETURN 9000 FORMAT(1H0,'User supplied Data Cards for Fragmentation and Decays' & ,' on Input read:') 9010 FORMAT(1H ) 9020 FORMAT(1H ,A) END