Back to home page

sPhenix code displayed by LXR

 
 

    


File indexing completed on 2025-08-05 08:21:09

0001  
0002 C*********************************************************************
0003  
0004 C...PYCOMP
0005 C...Compress the standard KF codes for use in mass and decay arrays;
0006 C...also checks whether a given code actually is defined.
0007  
0008       FUNCTION PYCOMP(KF)
0009  
0010 C...Double precision and integer declarations.
0011       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0012       IMPLICIT INTEGER(I-N)
0013       INTEGER PYK,PYCHGE,PYCOMP
0014 C...Commonblocks.
0015       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0016       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0017       SAVE /PYDAT1/,/PYDAT2/
0018 C...Local arrays and saved data.
0019       DIMENSION KFORD(100:500),KCORD(101:500)
0020       SAVE KFORD,KCORD,NFORD,KFLAST,KCLAST
0021  
0022 C...Whenever necessary reorder codes for faster search.
0023       IF(MSTU(20).EQ.0) THEN
0024         NFORD=100
0025         KFORD(100)=0
0026         DO 120 I=101,500
0027           KFA=KCHG(I,4)
0028           IF(KFA.LE.100) GOTO 120
0029           NFORD=NFORD+1
0030           DO 100 I1=NFORD-1,0,-1
0031             IF(KFA.GE.KFORD(I1)) GOTO 110
0032             KFORD(I1+1)=KFORD(I1)
0033             KCORD(I1+1)=KCORD(I1)
0034   100     CONTINUE
0035   110     KFORD(I1+1)=KFA
0036           KCORD(I1+1)=I
0037   120   CONTINUE
0038         MSTU(20)=1
0039         KFLAST=0
0040         KCLAST=0
0041       ENDIF
0042  
0043 C...Fast action if same code as in latest call.
0044       IF(KF.EQ.KFLAST) THEN
0045         PYCOMP=KCLAST
0046         RETURN
0047       ENDIF
0048  
0049 C...Starting values. Remove internal diquark flags.
0050       PYCOMP=0
0051       KFA=IABS(KF)
0052       IF(MOD(KFA/10,10).EQ.0.AND.KFA.LT.100000
0053      &     .AND.MOD(KFA/1000,10).GT.0) KFA=MOD(KFA,10000)
0054  
0055 C...Simple cases: direct translation.
0056       IF(KFA.GT.KFORD(NFORD)) THEN
0057       ELSEIF(KFA.LE.100) THEN
0058         PYCOMP=KFA
0059  
0060 C...Else binary search.
0061       ELSE
0062         IMIN=100
0063         IMAX=NFORD+1
0064   130   IAVG=(IMIN+IMAX)/2
0065         IF(KFORD(IAVG).GT.KFA) THEN
0066           IMAX=IAVG
0067           IF(IMAX.GT.IMIN+1) GOTO 130
0068         ELSEIF(KFORD(IAVG).LT.KFA) THEN
0069           IMIN=IAVG
0070           IF(IMAX.GT.IMIN+1) GOTO 130
0071         ELSE
0072           PYCOMP=KCORD(IAVG)
0073         ENDIF
0074       ENDIF
0075  
0076 C...Check if antiparticle allowed.
0077       IF(PYCOMP.NE.0.AND.KF.LT.0) THEN
0078         IF(KCHG(PYCOMP,3).EQ.0) PYCOMP=0
0079       ENDIF
0080  
0081 C...Save codes for possible future fast action.
0082       KFLAST=KF
0083       KCLAST=PYCOMP
0084  
0085       RETURN
0086       END