Back to home page

sPhenix code displayed by LXR

 
 

    


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

0001  
0002 C***********************************************************************
0003  
0004 C...PYI3AU
0005 C...Calculates real and imaginary parts of the auxiliary function I3;
0006 C...see R. K. Ellis, I. Hinchliffe, M. Soldate and J. J. van der Bij,
0007 C...Nucl. Phys. B297 (1988) 221.
0008  
0009       SUBROUTINE PYI3AU(EPS,RAT,Y3RE,Y3IM)
0010  
0011 C...Double precision and integer declarations.
0012       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0013       IMPLICIT INTEGER(I-N)
0014       INTEGER PYK,PYCHGE,PYCOMP
0015 C...Commonblocks.
0016       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0017       SAVE /PYDAT1/
0018  
0019       BE=0.5D0*(1D0+SQRT(1D0+RAT*EPS))
0020       IF(EPS.LT.1D0) GA=0.5D0*(1D0+SQRT(1D0-EPS))
0021  
0022       IF(EPS.LT.0D0) THEN
0023         IF(ABS(EPS).LT.1D-4.AND.ABS(RAT*EPS).LT.1D-4) THEN
0024           F3RE=PYSPEN(-0.25D0*EPS/(1D0+0.25D0*(RAT-1D0)*EPS),0D0,1)-
0025      &    PYSPEN((1D0-0.25D0*EPS)/(1D0+0.25D0*(RAT-1D0)*EPS),0D0,1)+
0026      &    PYSPEN(0.25D0*(RAT+1D0)*EPS/(1D0+0.25D0*RAT*EPS),0D0,1)-
0027      &    PYSPEN((RAT+1D0)/RAT,0D0,1)+0.5D0*(LOG(1D0+0.25D0*RAT*EPS)**2-
0028      &    LOG(0.25D0*RAT*EPS)**2)+LOG(1D0-0.25D0*EPS)*
0029      &    LOG((1D0+0.25D0*(RAT-1D0)*EPS)/(1D0+0.25D0*RAT*EPS))+
0030      &    LOG(-0.25D0*EPS)*LOG(0.25D0*RAT*EPS/(1D0+0.25D0*(RAT-1D0)*
0031      &    EPS))
0032         ELSEIF(ABS(EPS).LT.1D-4.AND.ABS(RAT*EPS).GE.1D-4) THEN
0033           F3RE=PYSPEN(-0.25D0*EPS/(BE-0.25D0*EPS),0D0,1)-
0034      &    PYSPEN((1D0-0.25D0*EPS)/(BE-0.25D0*EPS),0D0,1)+
0035      &    PYSPEN((BE-1D0+0.25D0*EPS)/BE,0D0,1)-
0036      &    PYSPEN((BE-1D0+0.25D0*EPS)/(BE-1D0),0D0,1)+
0037      &    0.5D0*(LOG(BE)**2-LOG(BE-1D0)**2)+
0038      &    LOG(1D0-0.25D0*EPS)*LOG((BE-0.25D0*EPS)/BE)+
0039      &    LOG(-0.25D0*EPS)*LOG((BE-1D0)/(BE-0.25D0*EPS))
0040         ELSEIF(ABS(EPS).GE.1D-4.AND.ABS(RAT*EPS).LT.1D-4) THEN
0041           F3RE=PYSPEN((GA-1D0)/(GA+0.25D0*RAT*EPS),0D0,1)-
0042      &    PYSPEN(GA/(GA+0.25D0*RAT*EPS),0D0,1)+
0043      &    PYSPEN((1D0+0.25D0*RAT*EPS-GA)/(1D0+0.25D0*RAT*EPS),0D0,1)-
0044      &    PYSPEN((1D0+0.25D0*RAT*EPS-GA)/(0.25D0*RAT*EPS),0D0,1)+
0045      &    0.5D0*(LOG(1D0+0.25D0*RAT*EPS)**2-LOG(0.25D0*RAT*EPS)**2)+
0046      &    LOG(GA)*LOG((GA+0.25D0*RAT*EPS)/(1D0+0.25D0*RAT*EPS))+
0047      &    LOG(GA-1D0)*LOG(0.25D0*RAT*EPS/(GA+0.25D0*RAT*EPS))
0048         ELSE
0049           F3RE=PYSPEN((GA-1D0)/(GA+BE-1D0),0D0,1)-
0050      &    PYSPEN(GA/(GA+BE-1D0),0D0,1)+PYSPEN((BE-GA)/BE,0D0,1)-
0051      &    PYSPEN((BE-GA)/(BE-1D0),0D0,1)+0.5D0*(LOG(BE)**2-
0052      &    LOG(BE-1D0)**2)+LOG(GA)*LOG((GA+BE-1D0)/BE)+
0053      &    LOG(GA-1D0)*LOG((BE-1D0)/(GA+BE-1D0))
0054         ENDIF
0055         F3IM=0D0
0056       ELSEIF(EPS.LT.1D0) THEN
0057         IF(ABS(EPS).LT.1D-4.AND.ABS(RAT*EPS).LT.1D-4) THEN
0058           F3RE=PYSPEN(-0.25D0*EPS/(1D0+0.25D0*(RAT-1D0)*EPS),0D0,1)-
0059      &    PYSPEN((1D0-0.25D0*EPS)/(1D0+0.25D0*(RAT-1D0)*EPS),0D0,1)+
0060      &    PYSPEN((1D0-0.25D0*EPS)/(-0.25D0*(RAT+1D0)*EPS),0D0,1)-
0061      &    PYSPEN(1D0/(RAT+1D0),0D0,1)+LOG((1D0-0.25D0*EPS)/
0062      &    (0.25D0*EPS))*LOG((1D0+0.25D0*(RAT-1D0)*EPS)/
0063      &    (0.25D0*(RAT+1D0)*EPS))
0064           F3IM=-PARU(1)*LOG((1D0+0.25D0*(RAT-1D0)*EPS)/
0065      &    (0.25D0*(RAT+1D0)*EPS))
0066         ELSEIF(ABS(EPS).LT.1D-4.AND.ABS(RAT*EPS).GE.1D-4) THEN
0067           F3RE=PYSPEN(-0.25D0*EPS/(BE-0.25D0*EPS),0D0,1)-
0068      &    PYSPEN((1D0-0.25D0*EPS)/(BE-0.25D0*EPS),0D0,1)+
0069      &    PYSPEN((1D0-0.25D0*EPS)/(1D0-0.25D0*EPS-BE),0D0,1)-
0070      &    PYSPEN(-0.25D0*EPS/(1D0-0.25D0*EPS-BE),0D0,1)+
0071      &    LOG((1D0-0.25D0*EPS)/(0.25D0*EPS))*
0072      &    LOG((BE-0.25D0*EPS)/(BE-1D0+0.25D0*EPS))
0073           F3IM=-PARU(1)*LOG((BE-0.25D0*EPS)/(BE-1D0+0.25D0*EPS))
0074         ELSEIF(ABS(EPS).GE.1D-4.AND.ABS(RAT*EPS).LT.1D-4) THEN
0075           F3RE=PYSPEN((GA-1D0)/(GA+0.25D0*RAT*EPS),0D0,1)-
0076      &    PYSPEN(GA/(GA+0.25D0*RAT*EPS),0D0,1)+
0077      &    PYSPEN(GA/(GA-1D0-0.25D0*RAT*EPS),0D0,1)-
0078      &    PYSPEN((GA-1D0)/(GA-1D0-0.25D0*RAT*EPS),0D0,1)+
0079      &    LOG(GA/(1D0-GA))*LOG((GA+0.25D0*RAT*EPS)/
0080      &    (1D0+0.25D0*RAT*EPS-GA))
0081           F3IM=-PARU(1)*LOG((GA+0.25D0*RAT*EPS)/
0082      &    (1D0+0.25D0*RAT*EPS-GA))
0083         ELSE
0084           F3RE=PYSPEN((GA-1D0)/(GA+BE-1D0),0D0,1)-
0085      &    PYSPEN(GA/(GA+BE-1D0),0D0,1)+PYSPEN(GA/(GA-BE),0D0,1)-
0086      &    PYSPEN((GA-1D0)/(GA-BE),0D0,1)+LOG(GA/(1D0-GA))*
0087      &    LOG((GA+BE-1D0)/(BE-GA))
0088           F3IM=-PARU(1)*LOG((GA+BE-1D0)/(BE-GA))
0089         ENDIF
0090       ELSE
0091         RSQ=EPS/(EPS-1D0+(2D0*BE-1D0)**2)
0092         RCTHE=RSQ*(1D0-2D0*BE/EPS)
0093         RSTHE=SQRT(MAX(0D0,RSQ-RCTHE**2))
0094         RCPHI=RSQ*(1D0+2D0*(BE-1D0)/EPS)
0095         RSPHI=SQRT(MAX(0D0,RSQ-RCPHI**2))
0096         R=SQRT(RSQ)
0097         THE=ACOS(MAX(-0.999999D0,MIN(0.999999D0,RCTHE/R)))
0098         PHI=ACOS(MAX(-0.999999D0,MIN(0.999999D0,RCPHI/R)))
0099         F3RE=PYSPEN(RCTHE,RSTHE,1)+PYSPEN(RCTHE,-RSTHE,1)-
0100      &  PYSPEN(RCPHI,RSPHI,1)-PYSPEN(RCPHI,-RSPHI,1)+
0101      &  (PHI-THE)*(PHI+THE-PARU(1))
0102         F3IM=PYSPEN(RCTHE,RSTHE,2)+PYSPEN(RCTHE,-RSTHE,2)-
0103      &  PYSPEN(RCPHI,RSPHI,2)-PYSPEN(RCPHI,-RSPHI,2)
0104       ENDIF
0105  
0106       Y3RE=2D0/(2D0*BE-1D0)*F3RE
0107       Y3IM=2D0/(2D0*BE-1D0)*F3IM
0108  
0109       RETURN
0110       END