* Subroutine Hzfilhep ************************************************************* * Purpose: * Transfer data to HERACMN and HEPEVTP * Input: none * Output: none * Author: N. Brook * Modified : M. Hayes (for 'PHO') * N. Pavel introduce POMPYT 8.5.96 * H. Jung (RAPGAP with PYTHIA6) * A. Solano (interface RIDI - 15.12.98) ************************************************************* *KEEP,HEPEVTP. * * HEP event prime common * (for explanation see manual) Integer NMXHEP PARAMETER (NMXHEP=2000) Integer NEVHEP,NHEP,ISTHEP,IDHEP Integer JMOHEP,JDAHEP Double Precision PHEP,VHEP COMMON/HEPEVTP/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) * *KEEP,HERACMN. * * HERA common * * GEN: Name of generator * XSEC: total cross section (in pb) * IHCHRG: charge of particle/parton times 3 * NTOT : Number of total events * WTX : event weight * Character*8 Gen Double Precision Xsec Integer ihchrg Real wtx, Ntot Common /HERACMN/ Xsec, Gen, ihchrg(nmxhep), Ntot, wtx * *KEND. Double Precision EVWGT,AVWGT,WGTMAX,WGTSUM,WSQSUM,WBIGST,GAMWT, & TLOUT COMMON/HWEVNT/EVWGT,AVWGT,WGTMAX,WGTSUM,WSQSUM,WBIGST,GAMWT,TLOUT, & NRN(2),MAXER,NUMER,NUMERU,MAXPR,LWEVT,ISTAT,IERROR,NOWGT,NWGTS, & IDHW(NMXHEP),GENSOF * COMMON /LEPTOU/ CUT(14),LST(40),PARL(30),X,Y,W2,Q2,U Common/Pyint5/Ngen(0:200,3),Xxsec(0:200,3) * COMMON/POMSIG/NEVT,SIGTOT * COMMON /RESULT/ S1,S2,S3,S4 logical lp Data lp/.false./ * * RAPGAP COMMON for xsec DOUBLE PRECISION AVGI,SD COMMON/EFFIC/AVGI,SD,NING,NOUTG * RIDI commons logical duejet,trejet,fragm,wei,two,longit,transv,user logical lightf,thlim,charm,strange,checkout,onlych COMMON/LOGICA/duejet,trejet,fragm,wei,two,longit,transv,user, + lightf,thlim,charm,strange,checkout,onlych Integer nevent2,itoteve2,itwoev2,iwei2,nmass Real fk_2,weimax2, + sig2t,sig2l,weit2,weil2,twint2,twinte2, + cs2,cst2,csl2,tcs2,tcse2, + tcst2,tcste2,tcsl2,tcsle2, + tcsb2,tcsbe2,tcsi2,tcsie2,tcsa2,tcsae2,tcsf2,tcsfe2 COMMON/WEI2/nevent2,itoteve2,itwoev2,iwei2,nmass,fk_2,weimax2, + sig2t,sig2l,weit2,weil2,twint2(7),twinte2(7), + cs2(2),cst2(2),csl2(2),tcs2(2),tcse2(2), + tcst2(2),tcste2(2),tcsl2(2),tcsle2(2), + tcsb2,tcsbe2,tcsi2,tcsie2,tcsa2,tcsae2,tcsf2,tcsfe2 Integer nevent3,ITOTEVE3,itwoev3,IWEI3,nskip Real fk_3,weimax3, + weit3,weil3,TWINT3,TWINTE3, + cs3,cst3,csl3,tcs3,tcse3, + tcst3,tcste3,tcsl3,tcsle3, + tcsb3,tcsbe3,tcsi3,tcsie3,tcsa3,tcsae3,tcsf3,tcsfe3 COMMON/WEI3/nevent3,ITOTEVE3,itwoev3,IWEI3,nskip,fk_3,weimax3, + weit3,weil3,TWINT3(7),TWINTE3(7), + cs3(2),cst3(2),csl3(2),tcs3(2),tcse3(2), + tcst3(2),tcste3(2),tcsl3(2),tcsle3(2), + tcsb3,tcsbe3,tcsi3,tcsie3,tcsa3,tcsae3,tcsf3,tcsfe3 logical radcor,radcor_i,radcor_f,radcor_a common/radlog/radcor,radcor_i,radcor_f,radcor_a * include LUJETS common COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) * include pythia6 pyjets common double precision PP,VP COMMON/PYJETS/NP,NPAD,KP(4000,5),PP(4000,5),VP(4000,5) Data Ncnt /0/ * Ncnt = Ncnt + 1 Ntot = Ncnt * if (lp) then write(6,*) ' ncnt= ',ncnt,' gen= ',gen endif * IF(gen(1:3).eq.'PYT'.or.gen(1:3).eq.'LEP'.or.gen(1:3).eq.'ARI' & .or.gen(1:3).eq.'LEG'.or.gen(1:3).eq.'RAP'.or.gen(1:3).eq.'RID' & ) then c if(gen(1:3).eq.'RID') then if(radcor) then c c Born cross section: run without radiative corrections c write(6,*) ' Please run RIDI without QED rad. correction ' write(6,*) ' Program stopped ' STOP elseif(wei) then c c Run without weights to avoid errors in using them c write(6,*) ' Please run RIDI without weights ' write(6,*) ' Program stopped ' STOP endif c c Get virtual photon four-vector c DO J = 1,4 P(N+1,J) = P(1,J)-P(3,J) ENDDO P(N+1,5) = & P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2-P(N+1,3)**2 P(N+1,5) = -SQRT(ABS(P(N+1,5))) K(N+1,1) = 21 K(N+1,2) = 22 K(N+1,3) = 1 N = N+1 endif c c write(6,*) ' check on LUJETS or PYJETS common ' IF(N.GT.0) THEN c write(6,*) ' LUJETS common found ' Call HzLuhepc(1) Call HzLuncop ELSEIF(NP.GT.0) THEN c write(6,*) ' PYJETS common found' Call Hzpyhepc(1) ELSE write(6,*) ' cannot determine LUJETS or PYJETS common ' ENDIF c If(gen(1:3).eq.'PYT') Then xsec = dble(Xxsec(0,3)) Elseif(gen(1:3).eq.'LEG') Then xsec = dble(s1) Elseif(gen(1:3).eq.'RAP') Then xsec = AVGI*1000. Elseif(gen(1:3).eq.'RID') Then xsec = 0. if((itoteve2+nmass).gt.0) xsec = TCS2(1)/(itoteve2+nmass) if((itoteve3+nskip).gt.0) & xsec = xsec + TCS3(1)/(itoteve3+nskip) xsec = xsec*1000. else xsec = dble(parl(24)) Endif if (lp) write(6,*) ' xsec= ',xsec * ELSE IF((GEN(1:3).EQ.'DJA')) THEN CALL HZDJHEPC(1) if (lp) write(6,*) ' ...calling hzluncop ' CALL HZLUNCOP XSEC = DBLE(PARL(24)) if (lp) write(6,*) ' xsec= ',xsec * else if(gen(1:3).eq.'HRW') Then Call Hzhrwcop xsec = avwgt else if(gen(1:3).eq.'PHO') Then Call Hzphocop C please note the cross section is not filled here. This is left to the C user, due to the design of PHOJET. * --> NPA 8.5.96 else if(gen(1:3).eq.'POM') Then call hzgamad c write(6,*) ' check on LUJETS or PYJETS common ' IF(N.GT.0) THEN c write(6,*) ' LUJETS common found ' Call HzLuhepc(1) Call HzLuncop ELSEIF(NP.GT.0) THEN c write(6,*) ' PYJETS common found' Call Hzpyhepc(1) ELSE write(6,*) ' cannot determine LUJETS or PYJETS common ' ENDIF c from mb --> pb xsec = sigtot*1.e9 call hzdifkin * --> end NPA 8.5.96 else if(gen(1:3).eq.'INS') Then Call Hzhrwcop xsec = avwgt Else Write(6,*) ' HZFILHEP: UNKNOWN GENERATOR' Endif * wtx=1. * Return End * Function Hzibeam(ip,il) ******************************************************* * Purpose: * Find posn of proton and lepton beam * returns * If find both beams Hzibeam = 1 * if find only lepton beam Hzibeam = 0 * if find only proton beam Hzibeam = -1 * Input: none * Output: ip pointer to proton * il pointer to lepton * * Author; N. Brook * PHOJET mods : M. Hayes * Gen="POM" added by H. Jung * Gen='RID' added by A. Solano ******************************************************* Implicit Double Precision (A-H,O-Z) Logical llep,lprot,lp Data lp/.false./ * *KEEP,HEPEVTP. * * HEP event prime common * (for explanation see manual) Integer NMXHEP PARAMETER (NMXHEP=2000) Integer NEVHEP,NHEP,ISTHEP,IDHEP Integer JMOHEP,JDAHEP Double Precision PHEP,VHEP COMMON/HEPEVTP/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) * *KEEP,HERACMN. * * HERA common * * GEN: Name of generator * XSEC: total cross section (in pb) * IHCHRG: charge of particle/parton times 3 * NTOT : Number of total events * WTX : event weight * Character*8 Gen Double Precision Xsec Integer ihchrg Real wtx, Ntot Common /HERACMN/ Xsec, Gen, ihchrg(nmxhep), Ntot, wtx * *KEEP,HZFUNC. * * Function declarations for Hztool functions * DOUBLE PRECISION HzPhmang DOUBLE PRECISION HzDiskin DOUBLE PRECISION HzPhokin Integer HzIpgamn Integer HzIdelec Integer HzIpgam Integer HzIbeam Integer HzLchge Integer HzLcomp * *KEND. * hzibeam = -2 llep = .false. lprot = .false. ip=-1 il=-1 If(gen(1:3).eq.'PYT'.or.gen(1:3).eq.'LEP'.or.gen(1:3).eq.'ARI' & .or.gen(1:3).eq.'LEG' .or.gen(1:3).eq.'RAP'.or.gen(1:3).eq.'RID' & )Then Do Ihep = Nhep,1,-1 C*TC c write(6,*) ' ihep = ',ihep,' ist= ',Isthep(ihep), c & ' id= ',idhep(ihep) * If(Isthep(ihep).eq.3 + .and.idhep(ihep).eq.2212) Then ip = ihep hzibeam = hzibeam + 1 Else if(Isthep(ihep).eq.3 + .and.abs(idhep(ihep)).eq.11) Then il = ihep hzibeam = hzibeam + 2 Endif If(hzibeam.eq.1) Return Enddo CTW-120697-> else if(gen(1:3).eq.'DJA') then ****** e+/- should be particle 1, the proton part. 2 if (idhep(2).eq.2212) then ip = 2 hzibeam = hzibeam + 1 endif if (abs(idhep(1)).eq.11) then il = 1 hzibeam = hzibeam + 2 endif if(hzibeam.eq.1) return CTW<-120697- Else If(gen(1:3).eq.'HRW' .or.gen(1:3).eq.'INS' ) Then Do Ihep = Nhep,1,-1 if (lp) then write(6,'(A,4F9.3,a,i4,a,i4)') '**hzibeam: HRW= ', + (PHEP(i,ihep),i=1,4),' ist= ', + Isthep(ihep),' idhep= ',idhep(ihep) endif If((Isthep(ihep).eq.101.or.Isthep(ihep).eq.102) + .and.idhep(ihep).eq.2212) Then ip = ihep hzibeam = hzibeam + 1 else If((Isthep(ihep).eq.101.or.Isthep(ihep).eq.102) + .and.abs(idhep(ihep)).eq.11) Then il = ihep hzibeam = hzibeam + 2 Endif If(hzibeam.eq.1) Return Enddo Else If(gen(1:3).eq.'PHO') Then * Trivial since the Proton should be particle 1, e+/- part. 2 IF (idhep(1).eq.2212) Then ip = 1 hzibeam = hzibeam + 1 Endif If (abs(idhep(2)).eq.11) Then il = 2 hzibeam = hzibeam + 2 Endif If(hzibeam.eq.1) Return Else If(gen(1:3).eq.'POM') Then * Trivial since the Proton should be particle 1, e+/- part. 2 IF (idhep(1).eq.2212) Then ip = 1 hzibeam = hzibeam + 1 Endif If (abs(idhep(2)).eq.11) Then il = 2 hzibeam = hzibeam + 2 Endif If(hzibeam.eq.1) Return Else write(6,*) '**hzibeam: generator not found gen=',gen Endif * Return End * Function Hzidelec(idum) ********************************************************** * Purpose: * hzidelec return the position of the scatt. e-/+ * * For LEPTO, ARIADNE and HERWIG the first stable particle is * the scatt. lepton * & in PYTHIA & in PHOJET (MEH'96) * & in RIDI (AS '98) * * if no stable particle found hzidelec < 0 * Input: idum only a dummy * * Author: N. Brook *********************************************************** Implicit Double Precision (A-H,O-Z) * *KEEP,HEPEVTP. * * HEP event prime common * (for explanation see manual) Integer NMXHEP PARAMETER (NMXHEP=2000) Integer NEVHEP,NHEP,ISTHEP,IDHEP Integer JMOHEP,JDAHEP Double Precision PHEP,VHEP COMMON/HEPEVTP/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) * *KEEP,HERACMN. * * HERA common * * GEN: Name of generator * XSEC: total cross section (in pb) * IHCHRG: charge of particle/parton times 3 * NTOT : Number of total events * WTX : event weight * Character*8 Gen Double Precision Xsec Integer ihchrg Real wtx, Ntot Common /HERACMN/ Xsec, Gen, ihchrg(nmxhep), Ntot, wtx * *KEEP,HZFUNC. * * Function declarations for Hztool functions * DOUBLE PRECISION HzPhmang DOUBLE PRECISION HzDiskin DOUBLE PRECISION HzPhokin DOUBLE PRECISION HZETA DOUBLE PRECISION HZPHI DOUBLE PRECISION HZET DOUBLE PRECISION HZPT DOUBLE PRECISION HZTHETA Integer HzIpgamn Integer HzIdelec Integer HzIpgam Integer HzIbeam Integer HzLchge Integer HzLcomp * *KEND. * hzidelec = -1 if(gen(1:3).eq.'LEP'.or.gen(1:3).eq.'ARI'.or. + gen(1:3).eq.'HRW'.or.gen(1:3).eq.'PYT'.or. + gen(1:3).eq.'POM'.or.gen(1:3).eq.'DJA'.or. + gen(1:3).eq.'PHO'.or.gen(1:3).eq.'RAP'.or. + gen(1:3).eq.'RID') then Do Ihep = 1, Nhep if(Isthep(Ihep).eq.1.and.abs(idhep(ihep)).eq.11) then hzidelec = ihep Return Endif Enddo Elseif (gen(1:3).eq.'INS') then Do Ihep = 1, Nhep if( Isthep(Ihep).eq.1 + .and.(abs(idhep(ihep)).eq.11))then hzidelec = ihep Return Endif Enddo Elseif (gen(1:3).eq.'LEG') then Do Ihep = 1, Nhep if( Isthep(Ihep).eq.1 + .and.(abs(idhep(ihep)).eq.11))then hzidelec = ihep Return Endif Enddo Else Write(6,*) ' HZIDELEC: UNKNOWN GENERATOR' Endif * return end * Function Hzipgamn(pgam) ********************************************************* * Purpose: * Hzipgamn flags whether a virtual photon is found or not * Input: none * Output: * If found it's 5vec (px,py,px,e,m) are passed back * via an argument * * Original Author: N. Brook * Modifications for photoproduction : M. Hayes * RIDI added: A. Solano ********************************************************* Implicit Double Precision (A-H,O-Z) *KEEP,HEPEVTP. * * HEP event prime common * (for explanation see manual) Integer NMXHEP PARAMETER (NMXHEP=2000) Integer NEVHEP,NHEP,ISTHEP,IDHEP Integer JMOHEP,JDAHEP Double Precision PHEP,VHEP COMMON/HEPEVTP/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) * *KEEP,HERACMN. * * HERA common * * GEN: Name of generator * XSEC: total cross section (in pb) * IHCHRG: charge of particle/parton times 3 * NTOT : Number of total events * WTX : event weight * Character*8 Gen Double Precision Xsec Integer ihchrg Real wtx, Ntot Common /HERACMN/ Xsec, Gen, ihchrg(nmxhep), Ntot, wtx * *KEEP,HZFUNC. * * Function declarations for Hztool functions * DOUBLE PRECISION HzPhmang DOUBLE PRECISION HzDiskin DOUBLE PRECISION HzPhokin Integer HzIpgamn Integer HzIdelec Integer HzIpgam Integer HzIbeam Integer HzLchge Integer HzLcomp * *KEND. * Integer intnev Data intnev/0/ Dimension Pgam(5) * intnev=intnev+1 Hzipgamn = 1 if(gen(1:3).eq.'LEP') Then ivirt = 3 if (intnev.lt.3) then PRINT*,'HZIPGAMn : Warning! You are using a DIS Monte Carlo' PRINT*,' in a photoproduction routine.' endif * elseif(gen(1:3).eq.'DJA') Then ivirt = 3 if (intnev.lt.3.or.intnev.eq.100) then PRINT*,'HZIPGAMn : Warning! You are using a DIS Monte Carlo' PRINT*,' (DJANGO) in a photoproduction routine.' endif * elseif(gen(1:3).eq.'RAP') Then ivirt = 3 elseif(gen(1:3).eq.'RID') Then if (intnev.lt.3) then PRINT*,'HZIPGAMn : Warning! You are using a DIS Monte Carlo' PRINT*,' in a photoproduction routine.' endif pgam(1) = phep(1,1)-phep(1,3) pgam(2) = phep(2,1)-phep(2,3) pgam(3) = phep(3,1)-phep(3,3) pgam(4) = phep(4,1)-phep(4,3) pgam(5) = phep(5,1)-phep(5,3) return elseif(gen(1:3).eq.'PHO') Then ivirt=4 elseif(gen(1:3).eq.'PYT'.or.gen(1:3).eq.'ARI') Then ielectron=-1 Do iloop=NHEP,1,-1 If (abs(IDHEP(iloop)).eq.11.and.ISTHEP(iloop).eq.1) Then ielectron=iloop ENDIF Enddo IF (ielectron.ne.-1) Then mother=JMOHEP(1,ielectron) pgam(1) = phep(1,mother)-phep(1,ielectron) pgam(2) = phep(2,mother)-phep(2,ielectron) pgam(3) = phep(3,mother)-phep(3,ielectron) pgam(4) = phep(4,mother)-phep(4,ielectron) pgam(5) = phep(5,mother)-phep(5,ielectron) return else hzipgamn = -1 Write(6,*) & 'HZIPGAMn: scattered e+/- not found from ',gen(1:3) Return endif elseif(gen(1:3).eq.'HRW') then ielectron=-1 Do iloop=NHEP,1,-1 If (abs(IDHEP(iloop)).eq.11.and.ISTHEP(iloop).eq.1) Then ielectron=iloop ENDIF Enddo Do iloop=NHEP,1,-1 If (abs(IDHEP(iloop)).eq.11) Then mother=iloop ENDIF Enddo IF (ielectron.ne.-1) Then pgam(1) = phep(1,mother)-phep(1,ielectron) pgam(2) = phep(2,mother)-phep(2,ielectron) pgam(3) = phep(3,mother)-phep(3,ielectron) pgam(4) = phep(4,mother)-phep(4,ielectron) pgam(5) = phep(5,mother)-phep(5,ielectron) return else hzipgamn = -1 Write(6,*) & 'HZIPGAMn: scattered e+/- not found from ',gen(1:3) Return endif else hzipgamn = -1 Write(6,*) 'HZIPGAMn: Unknown Generator ',gen(1:3) Return endif * pgam(1) = phep(1,ivirt) pgam(2) = phep(2,ivirt) pgam(3) = phep(3,ivirt) pgam(4) = phep(4,ivirt) pgam(5) = phep(5,ivirt) * IF (IDHEP(ivirt).eq.22.or.IDHEP(ivirt).eq.23) Then ELSE C hzipgamn = -1 Write(6,*) 'HZIPGAMn: photon misidentified in ',gen(1:3) Write(6,*) ' particle found id ',IDHEP(ivirt) Endif * Return End * FUNCTION HZLCOMP(KF) ****************************************************************** * Purpose: to compress the standard KF codes for use in mass and decay *...arrays; also to check whether a given code actually is defined. * 0: means not defined * Input: KF particle code * Output: * Author: N. Brook ****************************************************************** *KEEP,HZDAT. Integer KCHG COMMON/HZDAT/KCHG(500,3) * *KEEP,HZFUNC. * * Function declarations for Hztool functions * DOUBLE PRECISION HzPhmang DOUBLE PRECISION HzDiskin DOUBLE PRECISION HzPhokin DOUBLE PRECISION HZETA DOUBLE PRECISION HZPHI DOUBLE PRECISION HZET DOUBLE PRECISION HZPT DOUBLE PRECISION HZTHETA Integer HzIpgamn Integer HzIdelec Integer HzIpgam Integer HzIbeam Integer HzLchge Integer HzLcomp * *KEND. * * A. Solano 15.12.98 * The first time the program enters this function ( from hzluhepc(1) * called by hzfilhep ) COMMON/HZDAT/KCHG(500,3) is still empty, since * is filled at the first call of function HZLCHGE ( called by hzluncop, * called by hzfilhep right after hzluhepc(1) ). * Fill KCHG here copying from HZLCHGE * SAVE /LUDAT2/ * DIMENSION KFTAB(25),KCTAB(25) logical lp DATA KFTAB/211,111,221,311,321,130,310,213,113,223, &313,323,2112,2212,210,2110,2210,110,220,330,440,30443,30553,0,0/ DATA KCTAB/101,111,112,102,103,221,222,121,131,132, &122,123,332,333,281,282,283,284,285,286,287,231,235,0,0/ * data lp/.false./ * Integer Loca(500,3) Logical Init Data Init /.true./ DATA (LOCA(I,1),I= 1, 500)/-1,2,-1,2,-1,2,-1,2,2*0,-3,0,-3,0, &-3,0,-3,6*0,3,9*0,3,2*0,3,0,-1,44*0,2,-1,2,-1,2,3,11*0,3,0,2*3,0, &3,0,3,0,3,10*0,3,0,2*3,0,3,0,3,0,3,10*0,3,0,2*3,0,3,0,3,0,3,10*0, &3,0,2*3,0,3,0,3,0,3,10*0,3,0,2*3,0,3,0,3,0,3,10*0,3,0,2*3,0,3,0, &3,0,3,70*0,3,0,3,28*0,3,2*0,3,8*0,-3,8*0,3,0,-3,0,3,-3,3*0,3,6,0, &3,5*0,-3,0,3,-3,0,-3,4*0,-3,0,3,6,-3,0,3,-3,0,-3,0,3,6,0,3,5*0, &-3,0,3,-3,0,-3,114*0/ DATA (LOCA(I,2),I= 1, 500)/8*1,12*0,2,16*0,2,1,50*0,-1,410*0/ DATA (LOCA(I,3),I= 1, 500)/8*1,2*0,8*1,5*0,1,9*0,1,2*0,1,0,2*1, &41*0,1,0,7*1,10*0,10*1,10*0,10*1,10*0,10*1,10*0,10*1,10*0,10*1, &10*0,10*1,70*0,3*1,22*0,1,5*0,1,0,2*1,6*0,1,0,2*1,6*0,2*1,0,5*1, &0,6*1,4*0,6*1,4*0,16*1,4*0,6*1,114*0/ * If(Init) Then Init = .false. Call Ucopy(loca,kchg,1500) Endif * C...Starting values. HZLCOMP=0 KFA=IABS(KF) * if (lp) then write(6,*) ' KF= ',KF,' KFA= ',KFA endif C...Simple cases: direct translation or table. IF(KFA.EQ.0.OR.KFA.GE.100000) THEN RETURN ELSEIF(KFA.LE.100) THEN HZLCOMP=KFA IF(KF.LT.0.AND.KCHG(KFA,3).EQ.0) HZLCOMP=0 if (lp) write(6,*) 'kfa<100: HZLCOMP= ',HZLCOMP,KCHG(KFA,3) RETURN ELSE DO 100 IKF=1,23 IF(KFA.EQ.KFTAB(IKF)) THEN HZLCOMP=KCTAB(IKF) IF(KF.LT.0.AND.KCHG(HZLCOMP,3).EQ.0) HZLCOMP=0 if (lp) write(6,*) 'else HZLCOMP= ',HZLCOMP RETURN ENDIF 100 CONTINUE ENDIF C...Subdivide KF code into constituent pieces. KFLA=MOD(KFA/1000,10) KFLB=MOD(KFA/100,10) KFLC=MOD(KFA/10,10) KFLS=MOD(KFA,10) KFLR=MOD(KFA/10000,10) C...Mesons. IF(KFA-10000*KFLR.LT.1000) THEN IF(KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.0.OR.KFLC.EQ.9) THEN ELSEIF(KFLB.LT.KFLC) THEN ELSEIF(KF.LT.0.AND.KFLB.EQ.KFLC) THEN ELSEIF(KFLB.EQ.KFLC) THEN IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN HZLCOMP=110+KFLB ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN HZLCOMP=130+KFLB ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN HZLCOMP=150+KFLB ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN HZLCOMP=170+KFLB ELSEIF(KFLR.EQ.2.AND.KFLS.EQ.3) THEN HZLCOMP=190+KFLB ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.5) THEN HZLCOMP=210+KFLB ENDIF ELSEIF(KFLB.LE.5) THEN IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN HZLCOMP=100+((KFLB-1)*(KFLB-2))/2+KFLC ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN HZLCOMP=120+((KFLB-1)*(KFLB-2))/2+KFLC ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN HZLCOMP=140+((KFLB-1)*(KFLB-2))/2+KFLC ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN HZLCOMP=160+((KFLB-1)*(KFLB-2))/2+KFLC ELSEIF(KFLR.EQ.2.AND.KFLS.EQ.3) THEN HZLCOMP=180+((KFLB-1)*(KFLB-2))/2+KFLC ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.5) THEN HZLCOMP=200+((KFLB-1)*(KFLB-2))/2+KFLC ENDIF ELSEIF((KFLS.EQ.1.AND.KFLR.LE.1).OR.(KFLS.EQ.3.AND.KFLR.LE.2) & .OR.(KFLS.EQ.5.AND.KFLR.EQ.0)) THEN HZLCOMP=80+KFLB ENDIF C...Diquarks. ELSEIF((KFLR.EQ.0.OR.KFLR.EQ.1).AND.KFLC.EQ.0) THEN IF(KFLS.NE.1.AND.KFLS.NE.3) THEN ELSEIF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9) THEN ELSEIF(KFLA.LT.KFLB) THEN ELSEIF(KFLS.EQ.1.AND.KFLA.EQ.KFLB) THEN ELSE HZLCOMP=90 ENDIF C...Spin 1/2 baryons. ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.2) THEN IF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.9) THEN ELSEIF(KFLA.LE.KFLC.OR.KFLA.LT.KFLB) THEN ELSEIF(KFLA.GE.6.OR.KFLB.GE.4.OR.KFLC.GE.4) THEN HZLCOMP=80+KFLA ELSEIF(KFLB.LT.KFLC) THEN HZLCOMP=300+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLC*(KFLC-1))/2+KFLB ELSE HZLCOMP=330+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLB*(KFLB-1))/2+KFLC ENDIF C...Spin 3/2 baryons. ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.4) THEN IF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.9) THEN ELSEIF(KFLA.LT.KFLB.OR.KFLB.LT.KFLC) THEN ELSEIF(KFLA.GE.6.OR.KFLB.GE.4) THEN HZLCOMP=80+KFLA ELSE HZLCOMP=360+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLB*(KFLB-1))/2+KFLC ENDIF ENDIF RETURN END *