PHOS/shaker/lucomp.f

   1 *CMZ :          17/07/98  15.44.33  by  Federico Carminati
   2 *-- Author :
   3 C*********************************************************************
   4
   5       FUNCTION LUCOMP(KF)
   6
   7 C...Purpose: to compress the standard KF codes for use in mass and decay
   8 C...arrays; also to check whether a given code actually is defined.
   9 *KEEP,LUDAT2.
  10       COMMON /LUDAT2/ KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
  11       SAVE /LUDAT2/
  12 *KEND.
  13
  14 C...Subdivide KF code into constituent pieces.
  15       LUCOMP=0
  16       KFA=IABS(KF)
  17       KFLA=MOD(KFA/1000,10)
  18       KFLB=MOD(KFA/100,10)
  19       KFLC=MOD(KFA/10,10)
  20       KFLS=MOD(KFA,10)
  21       KFLR=MOD(KFA/10000,10)
  22
  23 C...Simple cases: direct translation or special codes.
  24       IF(KFA.EQ.0.OR.KFA.GE.100000) THEN
  25       ELSEIF(KFA.LE.100) THEN
  26         LUCOMP=KFA
  27         IF(KF.LT.0.AND.KCHG(KFA,3).EQ.0) LUCOMP=0
  28       ELSEIF(KFLS.EQ.0) THEN
  29         IF(KF.EQ.130) LUCOMP=221
  30         IF(KF.EQ.310) LUCOMP=222
  31         IF(KFA.EQ.210) LUCOMP=281
  32         IF(KFA.EQ.2110) LUCOMP=282
  33         IF(KFA.EQ.2210) LUCOMP=283
  34
  35 C...Mesons.
  36       ELSEIF(KFA-10000*KFLR.LT.1000) THEN
  37         IF(KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.0.OR.KFLC.EQ.9) THEN
  38         ELSEIF(KFLB.LT.KFLC) THEN
  39         ELSEIF(KF.LT.0.AND.KFLB.EQ.KFLC) THEN
  40         ELSEIF(KFLB.EQ.KFLC) THEN
  41           IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN
  42             LUCOMP=110+KFLB
  43           ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN
  44             LUCOMP=130+KFLB
  45           ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN
  46             LUCOMP=150+KFLB
  47           ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN
  48             LUCOMP=170+KFLB
  49           ELSEIF(KFLR.EQ.2.AND.KFLS.EQ.3) THEN
  50             LUCOMP=190+KFLB
  51           ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.5) THEN
  52             LUCOMP=210+KFLB
  53           ENDIF
  54         ELSEIF(KFLB.LE.5.AND.KFLC.LE.3) THEN
  55           IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN
  56             LUCOMP=100+((KFLB-1)*(KFLB-2))/2+KFLC
  57           ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN
  58             LUCOMP=120+((KFLB-1)*(KFLB-2))/2+KFLC
  59           ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN
  60             LUCOMP=140+((KFLB-1)*(KFLB-2))/2+KFLC
  61           ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN
  62             LUCOMP=160+((KFLB-1)*(KFLB-2))/2+KFLC
  63           ELSEIF(KFLR.EQ.2.AND.KFLS.EQ.3) THEN
  64             LUCOMP=180+((KFLB-1)*(KFLB-2))/2+KFLC
  65           ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.5) THEN
  66             LUCOMP=200+((KFLB-1)*(KFLB-2))/2+KFLC
  67           ENDIF
  68         ELSEIF((KFLS.EQ.1.AND.KFLR.LE.1).OR.(KFLS.EQ.3.AND.KFLR.LE.2).
  69      &  OR.(KFLS.EQ.5.AND.KFLR.EQ.0)) THEN
  70           LUCOMP=80+KFLB
  71         ENDIF
  72
  73 C...Diquarks.
  74       ELSEIF((KFLR.EQ.0.OR.KFLR.EQ.1).AND.KFLC.EQ.0) THEN
  75         IF(KFLS.NE.1.AND.KFLS.NE.3) THEN
  76         ELSEIF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9) THEN
  77         ELSEIF(KFLA.LT.KFLB) THEN
  78         ELSEIF(KFLS.EQ.1.AND.KFLA.EQ.KFLB) THEN
  79         ELSE
  80           LUCOMP=90
  81         ENDIF
  82
  83 C...Spin 1/2 baryons.
  84       ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.2) THEN
  85         IF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.9) THEN
  86         ELSEIF(KFLA.LE.KFLC.OR.KFLA.LT.KFLB) THEN
  87         ELSEIF(KFLA.GE.6.OR.KFLB.GE.4.OR.KFLC.GE.4) THEN
  88           LUCOMP=80+KFLA
  89         ELSEIF(KFLB.LT.KFLC) THEN
  90           LUCOMP=300+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLC*(KFLC-1))/2+KFLB
  91         ELSE
  92           LUCOMP=330+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLB*(KFLB-1))/2+KFLC
  93         ENDIF
  94
  95 C...Spin 3/2 baryons.
  96       ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.4) THEN
  97         IF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.9) THEN
  98         ELSEIF(KFLA.LT.KFLB.OR.KFLB.LT.KFLC) THEN
  99         ELSEIF(KFLA.GE.6.OR.KFLB.GE.4) THEN
 100           LUCOMP=80+KFLA
 101         ELSE
 102           LUCOMP=360+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLB*(KFLB-1))/2+KFLC
 103         ENDIF
 104       ENDIF
 105
 106       RETURN
 107       END