lsigmx.F

Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file lsigmx.F

C **********************************************************************

      SUBROUTINE lsigmx(NPAR,DERIV,DIFSIG,XF,IFLAG)

      IMPLICIT NONE

C...Calculates the negative of the differential cross-section.
C...In the generation procedure the maximum of the differential cross-
C...section is needed for weighting purposes. This maximum is found by
C...minimizing the negative differential cross-section using the MINUIT
C...routines which are then calling this routine.
C...More precisly, only the part of the cross-section formula which is
C...needed for the weighting procedure is included here.
*
* to avoid variable conflictions, a second keep element is necessary
* with the same common block name (see LPTOU2)
*
      COMMON /leptou/ cut(14),lst(40),parl(30),
     &                x,y,w2,q2,u
      REAL cut,parl,x,y,w2,q2,u
      INTEGER lst
      SAVE /leptou/

      COMMON /linter/ pari(50),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
      REAL  pari,ewqc,qc,zl,zq,pq
      SAVE /linter/

      COMMON /lintrl/ psave(3,4,5),ksave(4),xmin,xmax,ymin,ymax,
     &q2min,q2max,w2min,w2max,ilep,inu,ig,iz
      REAL psave,xmin,xmax,ymin,ymax,q2min,q2max,w2min,w2max
      INTEGER ksave,ilep,inu,ig,iz
      SAVE /lintrl/

      COMMON /loptim/ optx(4),opty(4),optq2(4),optw2(4),comfac
      REAL optx,opty,optq2,optw2,comfac
      SAVE /loptim/

      INTEGER  nlupdm,nplbuf
      parameter(nlupdm=4000,nplbuf=5)
      common/lujets/n,k(nlupdm,5),p(nlupdm,nplbuf),v(nlupdm,5)
      INTEGER  n,k
      REAL  p,v
      SAVE /lujets/

      common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
      INTEGER  mstu,mstj
      REAL  paru,parj
      SAVE /ludat1/

      common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
      INTEGER  kchg
      REAL  pmas,parf,vckm
      SAVE /ludat2/


      INTEGER npar,iflag,ncalls,lst2
      REAL deriv,difsig,xf,dummy,s,pm2,q2low,q2upp,ylow,yupp,w2low,
     +w2upp

      dimension deriv(30),xf(30)
      DATA ncalls/0/

      dummy=npar+deriv(1)
      IF(iflag.EQ.1) ncalls=0
      IF(iflag.EQ.2) WRITE(6,1000)

      difsig=1.e+12
      ncalls=ncalls+1
      x=xf(1)
      IF(x.LT.xmin) THEN
        difsig=(xmin-x)**2*1.e+11 
        RETURN
      ELSEIF(x.GT.xmax) THEN 
        difsig=(x-xmax)**2*1.e+11 
        RETURN
      ENDIF
      s=parl(21)
      pm2=psave(3,2,5)**2
      q2low=max(q2min,x*ymin*s,(w2min-pm2)*x/(1.-x))
      q2upp=min(q2max,x*ymax*s,(w2max-pm2)*x/(1.-x))
      ylow=max(ymin,q2min/(s*x),(w2min-pm2)/(s*(1.-x)))
      yupp=min(ymax,q2max/(s*x),(w2max-pm2)/(s*(1.-x)))
      w2low=max(w2min,(1.-x)*ymin*s+pm2,q2min*(1.-x)/x+pm2)
      w2upp=min(w2max,(1.-x)*ymax*s+pm2,q2max*(1.-x)/x+pm2)
      IF(lst(31).EQ.1) THEN
        q2=xf(2)
        IF(q2.LT.q2low) THEN
          difsig=(q2low-q2)**2*1.e+11 
          RETURN
        ELSEIF(q2.GT.q2upp) THEN 
          difsig=(q2-q2upp)**2*1.e+11 
          RETURN
        ENDIF
        y=q2/(parl(21)*x)
        w2=(1.-x)*y*parl(21)+pm2
      ELSEIF(lst(31).EQ.2) THEN
        y=xf(2)
        IF(y.LT.ylow) THEN
          difsig=(ylow-y)**2*1.e+11 
          RETURN
        ELSEIF(y.GT.yupp) THEN 
          difsig=(y-yupp)**2*1.e+11 
          RETURN
        ENDIF
        q2=y*x*parl(21)
        w2=(1.-x)*y*parl(21)+pm2
      ELSEIF(lst(31).EQ.3) THEN
        w2=xf(2)
        IF(w2.LT.w2low) THEN
          difsig=(w2low-w2)**2*1.e+11 
          RETURN
        ELSEIF(w2.GT.w2upp) THEN 
          difsig=(w2-w2upp)**2*1.e+11 
          RETURN
        ENDIF
        y=(w2-pm2)/((1.-x)*parl(21))
        q2=x*y*parl(21)
      ENDIF
      IF(q2.LT.q2low) THEN
        difsig=(q2low-q2)**2*1.e+11 
        RETURN
      ELSEIF(q2.GT.q2upp) THEN 
        difsig=(q2-q2upp)**2*1.e+11 
        RETURN
      ENDIF
      IF(y.LT.ylow) THEN
        difsig=(ylow-y)**2*1.e+11 
        RETURN
      ELSEIF(y.GT.yupp) THEN 
        difsig=(y-yupp)**2*1.e+11 
        RETURN
      ENDIF
      IF(w2.LT.w2low) THEN
        difsig=(w2low-w2)**2*1.e+11 
        RETURN
      ELSEIF(w2.GT.w2upp) THEN 
        difsig=(w2-w2upp)**2*1.e+11 
        RETURN
      ENDIF
      lst2=lst(2)
      lst(2)=-1
      CALL lepto
      lst(2)=lst2
      difsig=0. 
      IF(lst(21).NE.0) RETURN
      difsig=-pq(17)*comfac

      IF(lst(3).GE.4.AND.iflag.EQ.3)
     &WRITE(6,1100) ncalls,difsig,x,y,q2,w2
      RETURN

 1000 FORMAT(' Warning: IFLAG = 2 in call to LSIGMX, which does not '
     &,'calculate derivatives.')
 1100 FORMAT(/,5x,'Terminating entry in LSIGMX after ',i5,' calls.',/,
     &5x,'Best estimate of minimum found to be ',e12.4,/,
     &5x,'located at x, y, Q**2, W**2 = ',4g10.3,/)

      END