Back to home page

sPhenix code displayed by LXR

 
 

    


File indexing completed on 2025-08-05 08:15:44

0001     
0002 C*********************************************************************  
0003     
0004       SUBROUTINE LURADK(ECM,MK,PAK,THEK,PHIK,ALPK)  
0005     
0006 C...Purpose: to generate initial state photon radiation.    
0007       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) 
0008       SAVE /LUDAT1/ 
0009     
0010 C...Function: cumulative hard photon spectrum in QFD case.  
0011       FXK(XX)=2.*LOG(XX)+PARJ(161)*LOG(1.-XX)+PARJ(162)*XX+ 
0012      &PARJ(163)*LOG((XX-SZM)**2+SZW**2)+PARJ(164)*ATAN((XX-SZM)/SZW)    
0013     
0014 C...Determine whether radiative photon or not.  
0015       MK=0  
0016       PAK=0.    
0017       IF(PARJ(160).LT.RLU(0)) RETURN    
0018       MK=1  
0019     
0020 C...Photon energy range. Find photon momentum in QED case.  
0021       XKL=PARJ(135) 
0022       XKU=MIN(PARJ(136),1.-(2.*PARJ(127)/ECM)**2)   
0023       IF(MSTJ(102).LE.1) THEN   
0024   100   XK=1./(1.+(1./XKL-1.)*((1./XKU-1.)/(1./XKL-1.))**RLU(0))    
0025         IF(1.+(1.-XK)**2.LT.2.*RLU(0)) GOTO 100 
0026     
0027 C...Ditto in QFD case, by numerical inversion of integrated spectrum.   
0028       ELSE  
0029         SZM=1.-(PARJ(123)/ECM)**2   
0030         SZW=PARJ(123)*PARJ(124)/ECM**2  
0031         FXKL=FXK(XKL)   
0032         FXKU=FXK(XKU)   
0033         FXKD=1E-4*(FXKU-FXKL)   
0034         FXKR=FXKL+RLU(0)*(FXKU-FXKL)    
0035         NXK=0   
0036   110   NXK=NXK+1   
0037         XK=0.5*(XKL+XKU)    
0038         FXKV=FXK(XK)    
0039         IF(FXKV.GT.FXKR) THEN   
0040           XKU=XK    
0041           FXKU=FXKV 
0042         ELSE    
0043           XKL=XK    
0044           FXKL=FXKV 
0045         ENDIF   
0046         IF(NXK.LT.15.AND.FXKU-FXKL.GT.FXKD) GOTO 110    
0047         XK=XKL+(XKU-XKL)*(FXKR-FXKL)/(FXKU-FXKL)    
0048       ENDIF 
0049       PAK=0.5*ECM*XK    
0050     
0051 C...Photon polar and azimuthal angle.   
0052       PME=2.*(ULMASS(11)/ECM)**2    
0053   120 CTHM=PME*(2./PME)**RLU(0) 
0054       IF(1.-(XK**2*CTHM*(1.-0.5*CTHM)+2.*(1.-XK)*PME/MAX(PME,   
0055      &CTHM*(1.-0.5*CTHM)))/(1.+(1.-XK)**2).LT.RLU(0)) GOTO 120  
0056       CTHE=1.-CTHM  
0057       IF(RLU(0).GT.0.5) CTHE=-CTHE  
0058       STHE=SQRT(MAX(0.,(CTHM-PME)*(2.-CTHM)))   
0059       THEK=ULANGL(CTHE,STHE)    
0060       PHIK=PARU(2)*RLU(0)   
0061     
0062 C...Rotation angle for hadronic system. 
0063       SGN=1.    
0064       IF(0.5*(2.-XK*(1.-CTHE))**2/((2.-XK)**2+(XK*CTHE)**2).GT. 
0065      &RLU(0)) SGN=-1.   
0066       ALPK=ASIN(SGN*STHE*(XK-SGN*(2.*SQRT(1.-XK)-2.+XK)*CTHE)/  
0067      &(2.-XK*(1.-SGN*CTHE)))    
0068     
0069       RETURN    
0070       END