* * $Id: luupda.F,v 1.1.1.1 1996/01/11 14:05:24 mclareni Exp $ * * $Log: luupda.F,v $ * Revision 1.1.1.1 1996/01/11 14:05:24 mclareni * Fritiof * * C********************************************************************* SUBROUTINE LUUPDA(MUPDA,LFN) C...Purpose: to facilitate the updating of particle and decay data. COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) COMMON/LUDAT4/CHAF(500) CHARACTER CHAF*8 SAVE /LUDAT1/,/LUDAT2/,/LUDAT3/,/LUDAT4/ CHARACTER CHINL*80,CHKC*4,CHVAR(19)*9,CHLIN*72, &CHBLK(20)*72,CHOLD*12,CHTMP*12,CHNEW*12,CHCOM*12 DATA CHVAR/ 'KCHG(I,1)','KCHG(I,2)','KCHG(I,3)','PMAS(I,1)', &'PMAS(I,2)','PMAS(I,3)','PMAS(I,4)','MDCY(I,1)','MDCY(I,2)', &'MDCY(I,3)','MDME(I,1)','MDME(I,2)','BRAT(I) ','KFDP(I,1)', &'KFDP(I,2)','KFDP(I,3)','KFDP(I,4)','KFDP(I,5)','CHAF(I) '/ C...Write information on file for editing. IF(MSTU(12).GE.1) CALL LULIST(0) IF(MUPDA.EQ.1) THEN DO 110 KC=1,MSTU(6) WRITE(LFN,5000) KC,CHAF(KC),(KCHG(KC,J1),J1=1,3), & (PMAS(KC,J2),J2=1,4),MDCY(KC,1) DO 100 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 100 WRITE(LFN,5100) MDME(IDC,1),MDME(IDC,2),BRAT(IDC), & (KFDP(IDC,J),J=1,5) 110 CONTINUE C...Reset variables and read information from edited file. ELSEIF(MUPDA.EQ.2) THEN DO 120 I=1,MSTU(7) MDME(I,1)=1 MDME(I,2)=0 BRAT(I)=0. DO 120 J=1,5 120 KFDP(I,J)=0 KC=0 IDC=0 NDC=0 130 READ(LFN,5200,END=140) CHINL IF(CHINL(2:5).NE.' ') THEN CHKC=CHINL(2:5) IF(KC.NE.0) THEN MDCY(KC,2)=0 IF(NDC.NE.0) MDCY(KC,2)=IDC+1-NDC MDCY(KC,3)=NDC ENDIF READ(CHKC,5300) KC IF(KC.LE.0.OR.KC.GT.MSTU(6)) CALL LUERRM(27, & '(LUUPDA:) Read KC code illegal, KC ='//CHKC) READ(CHINL,5000) KCR,CHAF(KC),(KCHG(KC,J1),J1=1,3), & (PMAS(KC,J2),J2=1,4),MDCY(KC,1) NDC=0 ELSE IDC=IDC+1 NDC=NDC+1 IF(IDC.GE.MSTU(7)) CALL LUERRM(27, & '(LUUPDA:) Decay data arrays full by KC ='//CHKC) READ(CHINL,5100) MDME(IDC,1),MDME(IDC,2),BRAT(IDC), & (KFDP(IDC,J),J=1,5) ENDIF GOTO 130 140 MDCY(KC,2)=0 IF(NDC.NE.0) MDCY(KC,2)=IDC+1-NDC MDCY(KC,3)=NDC C...Perform possible tests that new information is consistent. MSTJ24=MSTJ(24) MSTJ(24)=0 DO 170 KC=1,MSTU(6) WRITE(CHKC,5300) KC IF(MIN(PMAS(KC,1),PMAS(KC,2),PMAS(KC,3),PMAS(KC,1)-PMAS(KC,3), & PMAS(KC,4)).LT.0..OR.MDCY(KC,3).LT.0) CALL LUERRM(17, & '(LUUPDA:) Mass/width/life/(# channels) wrong for KC ='//CHKC) BRSUM=0. DO 160 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 IF(MDME(IDC,2).GT.80) GOTO 160 KQ=KCHG(KC,1) PMS=PMAS(KC,1)-PMAS(KC,3)-PARJ(64) MERR=0 DO 150 J=1,5 KP=KFDP(IDC,J) IF(KP.EQ.0.OR.KP.EQ.81.OR.IABS(KP).EQ.82) THEN ELSEIF(LUCOMP(KP).EQ.0) THEN MERR=3 ELSE KQ=KQ-LUCHGE(KP) PMS=PMS-ULMASS(KP) ENDIF 150 CONTINUE IF(KQ.NE.0) MERR=MAX(2,MERR) IF(KFDP(IDC,2).NE.0.AND.(KC.LE.20.OR.KC.GT.40).AND. & (KC.LE.80.OR.KC.GT.100).AND.MDME(IDC,2).NE.34.AND. & MDME(IDC,2).NE.61.AND.PMS.LT.0.) MERR=MAX(1,MERR) IF(MERR.EQ.3) CALL LUERRM(17, & '(LUUPDA:) Unknown particle code in decay of KC ='//CHKC) IF(MERR.EQ.2) CALL LUERRM(17, & '(LUUPDA:) Charge not conserved in decay of KC ='//CHKC) IF(MERR.EQ.1) CALL LUERRM(7, & '(LUUPDA:) Kinematically unallowed decay of KC ='//CHKC) BRSUM=BRSUM+BRAT(IDC) 160 CONTINUE WRITE(CHTMP,5500) BRSUM IF(ABS(BRSUM).GT.0.0005.AND.ABS(BRSUM-1.).GT.0.0005) CALL & LUERRM(7,'(LUUPDA:) Sum of branching ratios is '//CHTMP(5:12)// & ' for KC ='//CHKC) 170 CONTINUE MSTJ(24)=MSTJ24 C...Initialize writing of DATA statements for inclusion in program. ELSEIF(MUPDA.EQ.3) THEN DO 240 IVAR=1,19 NDIM=MSTU(6) IF(IVAR.GE.11.AND.IVAR.LE.18) NDIM=MSTU(7) NLIN=1 CHLIN=' ' CHLIN(7:35)='DATA ('//CHVAR(IVAR)//',I= 1, )/' LLIN=35 CHOLD='START' C...Loop through variables for conversion to characters. DO 220 IDIM=1,NDIM IF(IVAR.EQ.1) WRITE(CHTMP,5400) KCHG(IDIM,1) IF(IVAR.EQ.2) WRITE(CHTMP,5400) KCHG(IDIM,2) IF(IVAR.EQ.3) WRITE(CHTMP,5400) KCHG(IDIM,3) IF(IVAR.EQ.4) WRITE(CHTMP,5500) PMAS(IDIM,1) IF(IVAR.EQ.5) WRITE(CHTMP,5500) PMAS(IDIM,2) IF(IVAR.EQ.6) WRITE(CHTMP,5500) PMAS(IDIM,3) IF(IVAR.EQ.7) WRITE(CHTMP,5500) PMAS(IDIM,4) IF(IVAR.EQ.8) WRITE(CHTMP,5400) MDCY(IDIM,1) IF(IVAR.EQ.9) WRITE(CHTMP,5400) MDCY(IDIM,2) IF(IVAR.EQ.10) WRITE(CHTMP,5400) MDCY(IDIM,3) IF(IVAR.EQ.11) WRITE(CHTMP,5400) MDME(IDIM,1) IF(IVAR.EQ.12) WRITE(CHTMP,5400) MDME(IDIM,2) IF(IVAR.EQ.13) WRITE(CHTMP,5500) BRAT(IDIM) IF(IVAR.EQ.14) WRITE(CHTMP,5400) KFDP(IDIM,1) IF(IVAR.EQ.15) WRITE(CHTMP,5400) KFDP(IDIM,2) IF(IVAR.EQ.16) WRITE(CHTMP,5400) KFDP(IDIM,3) IF(IVAR.EQ.17) WRITE(CHTMP,5400) KFDP(IDIM,4) IF(IVAR.EQ.18) WRITE(CHTMP,5400) KFDP(IDIM,5) IF(IVAR.EQ.19) CHTMP=CHAF(IDIM) C...Length of variable, trailing decimal zeros, quotation marks. LLOW=1 LHIG=1 DO 180 LL=1,12 IF(CHTMP(13-LL:13-LL).NE.' ') LLOW=13-LL 180 IF(CHTMP(LL:LL).NE.' ') LHIG=LL CHNEW=CHTMP(LLOW:LHIG)//' ' LNEW=1+LHIG-LLOW IF((IVAR.GE.4.AND.IVAR.LE.7).OR.IVAR.EQ.13) THEN LNEW=LNEW+1 190 LNEW=LNEW-1 IF(CHNEW(LNEW:LNEW).EQ.'0') GOTO 190 IF(LNEW.EQ.1) CHNEW(1:2)='0.' IF(LNEW.EQ.1) LNEW=2 ELSEIF(IVAR.EQ.19) THEN DO 200 LL=LNEW,1,-1 IF(CHNEW(LL:LL).EQ.'''') THEN CHTMP=CHNEW CHNEW=CHTMP(1:LL)//''''//CHTMP(LL+1:11) LNEW=LNEW+1 ENDIF 200 CONTINUE CHTMP=CHNEW CHNEW(1:LNEW+2)=''''//CHTMP(1:LNEW)//'''' LNEW=LNEW+2 ENDIF C...Form composite character string, often including repetition counter. IF(CHNEW.NE.CHOLD) THEN NRPT=1 CHOLD=CHNEW CHCOM=CHNEW LCOM=LNEW ELSE LRPT=LNEW+1 IF(NRPT.GE.2) LRPT=LNEW+3 IF(NRPT.GE.10) LRPT=LNEW+4 IF(NRPT.GE.100) LRPT=LNEW+5 IF(NRPT.GE.1000) LRPT=LNEW+6 LLIN=LLIN-LRPT NRPT=NRPT+1 WRITE(CHTMP,5400) NRPT LRPT=1 IF(NRPT.GE.10) LRPT=2 IF(NRPT.GE.100) LRPT=3 IF(NRPT.GE.1000) LRPT=4 CHCOM(1:LRPT+1+LNEW)=CHTMP(13-LRPT:12)//'*'//CHNEW(1:LNEW) LCOM=LRPT+1+LNEW ENDIF C...Add characters to end of line, to new line (after storing old line), C...or to new block of lines (after writing old block). IF(LLIN+LCOM.LE.70) THEN CHLIN(LLIN+1:LLIN+LCOM+1)=CHCOM(1:LCOM)//',' LLIN=LLIN+LCOM+1 ELSEIF(NLIN.LE.19) THEN CHLIN(LLIN+1:72)=' ' CHBLK(NLIN)=CHLIN NLIN=NLIN+1 CHLIN(6:6+LCOM+1)='&'//CHCOM(1:LCOM)//',' LLIN=6+LCOM+1 ELSE CHLIN(LLIN:72)='/'//' ' CHBLK(NLIN)=CHLIN WRITE(CHTMP,5400) IDIM-NRPT CHBLK(1)(30:33)=CHTMP(9:12) DO 210 ILIN=1,NLIN 210 WRITE(LFN,5600) CHBLK(ILIN) NLIN=1 CHLIN=' ' CHLIN(7:35+LCOM+1)='DATA ('//CHVAR(IVAR)//',I= , )/'// & CHCOM(1:LCOM)//',' WRITE(CHTMP,5400) IDIM-NRPT+1 CHLIN(25:28)=CHTMP(9:12) LLIN=35+LCOM+1 ENDIF 220 CONTINUE C...Write final block of lines. CHLIN(LLIN:72)='/'//' ' CHBLK(NLIN)=CHLIN WRITE(CHTMP,5400) NDIM CHBLK(1)(30:33)=CHTMP(9:12) DO 230 ILIN=1,NLIN 230 WRITE(LFN,5600) CHBLK(ILIN) 240 CONTINUE ENDIF C...Formats for reading and writing particle data. 5000 FORMAT(1X,I4,2X,A8,3I3,3F12.5,2X,F12.5,I3) 5100 FORMAT(5X,2I5,F12.5,5I8) 5200 FORMAT(A80) 5300 FORMAT(I4) 5400 FORMAT(I12) 5500 FORMAT(F12.5) 5600 FORMAT(A72) RETURN END