PDF/spdf/strbebc.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.2  1996/10/30 08:32:16  cernlib
   6 * Version 7.04
   7 *
   8 * Revision 1.2  1996/10/28 15:13:56  pdflib
   9 * PDFLIB new version 7.04
  10 *
  11 * Revision 1.1.1.1  1996/04/12 15:29:48  plothow
  12 * Version 7.01
  13 *
  14 *
  15 #include "pdf/pilot.h"
  16       SUBROUTINE STRBEBC(DX,DQ,DUPV,DDNV,DSEA,DSTR,DGL)
  17 C     SUBROUTINE STRBEBC(DX,DQ,DUDV,DUDS,DSEA,DSTR,DGL)
  18 *********************************************************************
  19 *                                                                   *
  20 *     P.Gorbunov   /ITEP                                            *
  21 *     A.Maslennikov/ITEP                             May   1990     *
  22 *     coded after Z. Phys. C 36 (1987) 1, BEBC WA59                 *
  23 *                                                                   *
  24 *     Original publication:                                         *
  25 *     A.J. Buras and K.J.F. Gaemers, Nucl. Phys. B132 (1978) 249    *
  26 *                                                                   *
  27 *                                                                   *
  28 *     adapted and corrected by H.Plothow-Besch/PPE   April 1991     *
  29 *                                                                   *
  30 *********************************************************************
  31 C.
  32 #include "pdf/expdp.inc"
  33      +       DX,DQ,DUPV,DDNV,DSEA,DSTR,DGL
  34       REAL    X, Q, UPV, DNV, SEA, STR, GL, UDVAL, UDSEA
  35       PARAMETER (BVQ02=0.77, BSQ02=5.3, BGQ02=4., Q02=0.5)
  36       PARAMETER (EPS=0.5)
  37 C
  38       EXTERNAL VALDIS,V3
  39 C
  40       COMMON/W5051I1/
  41      +           GPSI(2:3),GAA(2:3),GPSIA(2:3),GAPSI(2:3),GMINUS(2:3),
  42      1           AL(2:3),BET(2:3),GPLUS(2:3),
  43      2           VNQ02(2:3),SNQ02(2:3),GNQ02(2:3)
  44 C
  45       PARAMETER (IX=112,IQ=40,NARG=2,KFUN=2)
  46       REAL ARG(NARG),ENT(IX+IQ),XQDUM(IX,IQ,KFUN),Q2P(IQ),XCO(IX)
  47       INTEGER NENT(NARG)
  48 C
  49       COMMON/W5051I2/ Q2L
  50       DATA ZERO/0./,HALF/0.5/,ONE/1./,TWO/2./,THRE/3./
  51       DATA INIT/0/
  52 C
  53       DATA XCO   /
  54      +0.5000E-04,0.5545E-04,0.6150E-04,0.6820E-04,0.7564E-04,0.8389E-04,
  55      +0.9303E-04,0.1032E-03,0.1144E-03,0.1269E-03,0.1407E-03,0.1561E-03,
  56      +0.1731E-03,0.1920E-03,0.2129E-03,0.2361E-03,0.2619E-03,0.2904E-03,
  57      +0.3221E-03,0.3572E-03,0.3961E-03,0.4393E-03,0.4872E-03,0.5404E-03,
  58      +0.5993E-03,0.6646E-03,0.7371E-03,0.8174E-03,0.9066E-03,0.1005E-02,
  59      +0.1115E-02,0.1237E-02,0.1371E-02,0.1521E-02,0.1687E-02,0.1871E-02,
  60      +0.2075E-02,0.2301E-02,0.2552E-02,0.2830E-02,0.3139E-02,0.3481E-02,
  61      +0.3860E-02,0.4281E-02,0.4748E-02,0.5266E-02,0.5840E-02,0.6476E-02,
  62      +0.7182E-02,0.7966E-02,0.8834E-02,0.9797E-02,0.1087E-01,0.1205E-01,
  63      +0.1336E-01,0.1482E-01,0.1644E-01,0.1823E-01,0.2022E-01,0.2242E-01,
  64      +0.2487E-01,0.2758E-01,0.3058E-01,0.3392E-01,0.3762E-01,0.4172E-01,
  65      +0.4627E-01,0.5131E-01,0.5690E-01,0.6311E-01,0.6999E-01,0.7762E-01,
  66      +0.8608E-01,0.9547E-01,0.1059E+00,0.1174E+00,0.1302E+00,0.1444E+00,
  67      +0.1602E+00,0.1776E+00,0.1970E+00,0.2185E+00,0.2423E+00,0.2687E+00,
  68      +0.2980E+00,0.3305E+00,0.3666E+00,0.4065E+00,0.4508E+00,0.5000E+00,
  69      +0.5321E+00,0.5643E+00,0.5964E+00,0.6286E+00,0.6607E+00,0.6929E+00,
  70      +0.7250E+00,0.7571E+00,0.7893E+00,0.8214E+00,0.8536E+00,0.8857E+00,
  71      +0.9,0.91,0.92,0.93,0.94,0.95,0.96,0.97,0.98,0.99/
  72 C
  73       SAVE NENT, ENT, XQDUM
  74 C
  75       IF(INIT.EQ.0) THEN
  76 C--------- initialize Buras-Gaemers parametrization
  77 C          BSMALL=(33.-8.)/3.
  78 C... in Buras-Gaemers paper (Nucl.Phys.132 (1978) 249) this is like:
  79            BSMALL=(33.-8.)/4.
  80            S=0.
  81            DO N=2,3
  82               S=S+1./N
  83               GPSI  (N)=8./6./BSMALL* (1.-2./N/(N+1)+4.*S)
  84               GAA   (N)=3./BSMALL* (1./3.-4./N/(N-1)-4./(N+1)/(N+2) +
  85      1                  4.*S)  + 8./3./BSMALL
  86               GPSIA (N)=2./BSMALL* (8./(N+2)+16./N/(N+1)/(N+2))
  87               GAPSI (N)=4./3./BSMALL* (1./(N+1)+2./N/(N-1))
  88               GMINUS(N)=0.5*(GPSI(N)+GAA(N) -
  89      1                  SQRT((GPSI(N)-GAA(N))**2+4.*GPSIA(N)*GAPSI(N)))
  90               GPLUS (N)=0.5*(GPSI(N)+GAA(N) +
  91      1                  SQRT((GPSI(N)-GAA(N))**2+4.*GPSIA(N)*GAPSI(N)))
  92               AL    (N)=GPSIA(N)*GAPSI(N)/
  93      1              (GPSIA(N)*GAPSI(N)+(GMINUS(N)-GPSI(N))**2)
  94               BET   (N)=0.5*AL(N)*(GPSI(N)-GMINUS(N))/GAPSI(N)
  95            ENDDO
  96
  97            Q2L     =Q02
  98 C
  99            VNQ02(2)= GAUSS(VALDIS,ZERO,ONE,EPS)
 100            VNQ02(3)= GAUSS(V3    ,ZERO,ONE,EPS)
 101            SNQ02(2)=VNQ02(2)*(ONE-BVQ02)/BVQ02
 102            SNQ02(3)=SNQ02(2)/(BSQ02+TWO)
 103            GNQ02(2)=ONE-SNQ02(2)-VNQ02(2)
 104            GNQ02(3)=GNQ02(2)/(BGQ02+TWO)
 105
 106 *--------- initialize interpolation tables
 107            DO I=1,IQ
 108               Q2L=I-HALF
 109               ENT(IX+I)=LOG10(Q2L)
 110               DO J=1,IX
 111                  ENT(J)=LOG10(XCO(J))
 112                  XX = XCO(J)
 113                  XQDUM(J,I,1)=VALDIS(XX)
 114                  XQDUM(J,I,2)=SEADIS(XX)
 115               ENDDO
 116            ENDDO
 117            NENT(1)=IX
 118            NENT(2)=IQ
 119
 120            INIT = 1
 121       ENDIF
 122       X = DX
 123       Q = DQ
 124       Q2IN  = Q*Q
 125       ARG(1)= LOG10(X)
 126       ARG(2)= LOG10( MAX( Q02,Q2IN))
 127       UDVAL = MAX(ZERO,FINT(NARG,ARG,NENT,ENT,XQDUM(1,1,1)))
 128       UPV = UDVAL*TWO/THRE
 129       DNV = UPV/TWO
 130       UDSEA = MAX(ZERO,FINT(NARG,ARG,NENT,ENT,XQDUM(1,1,2))) /
 131      +        (TWO+HALF)
 132       SEA  = UDSEA*HALF
 133       STR  = SEA*HALF
 134       GL  = 0.
 135 C
 136       DUPV = UPV
 137       DDNV = DNV
 138       DSEA = SEA
 139       DSTR = STR
 140       DGL  = GL
 141       RETURN
 142       END