PDF/spdf/structp.F

   1 #include "pdf/pilot.h"
   2 C
   3 C-----------------------------------------------------------------------
   4 C
   5       SUBROUTINE STRUCTP(X,Q2,P2,IP,
   6      +                             UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GL)
   7 C
   8 C  *********************************************************************
   9 C  *                                                                   *
  10 C  *   Main steering routine for all sets of structure functions       *
  11 C  *                                                                   *
  12 C  *                                                                   *
  13 C  *   Input:    X     = x value of parton                             *
  14 C  *             Q2    = QCD scale in GeV**2                           *
  15 C  *             P2    = Virtuality of the Photon in GeV**2            *
  16 C  *             IP    = Flag to evaluate off-shell anomalous photon   *
  17 C  *                     component                                     *
  18 C  *                                                                   *
  19 C  *   Output:   UPV   = up valence quark                              *
  20 C  *             DNV   = down valence quark                            *
  21 C  *             USEA  = sea (up_bar)                                  *
  22 C  *             DSEA  = sea (down_bar)                                *
  23 C  *             STR   = strange quark                                 *
  24 C  *             CHM   = charm quark                                   *
  25 C  *             BOT   = bottom quark                                  *
  26 C  *             TOP   = top quark                                     *
  27 C  *             GL    = gluon                                         *
  28 C  *                                                                   *
  29 C  *                                                                   *
  30 C  *   The variables  NPTYPE, NGROUP and NSET  should be,              *
  31 C  *   the variables  NFL, LO, TMAS  and                               *
  32 C  *   QCDL4, QCDL5, XMIN, XMAX, Q2MIN, Q2MAX                          *
  33 C  *   could be provided by the user via a call to the                 *
  34 C  *   subroutine PDFSET at the initialization phase, where            *
  35 C  *                                                                   *
  36 C  *             NPTYPE = Particle type                                *
  37 C  *                      (number or character string,                 *
  38 C  *                       1,2,3 or 'NU','PI','PH')                    *
  39 C  *                      of desired structure functions set           *
  40 C  *                      (Default: NPTYPE = 1  or  'NU'               *
  41 C  *             NGROUP = author group                                 *
  42 C  *                      (number or character string,                 *
  43 C  *                       1 to 7 or i.e. 'DFLM','MRS','MT','GRV',etc) *
  44 C  *                      of desired structure functions set           *
  45 C  *                      (Default: NGROUP = 5  or  'GRV')             *
  46 C  *             NSET   = number of desired structure functions set    *
  47 C  *                      (Default: NSET = 3)                          *
  48 C  *             NFL    = desired number of flavours for alpha(s)      *
  49 C  *                      (Default: NFL = 5)                           *
  50 C  *             LO     = order of alpha(s) calculation                *
  51 C  *                      (Default: LO = 2)                            *
  52 C  *             TMAS   = top quark mass in GeV/c**2  (optional)       *
  53 C  *                      (Default: TMAS = 100.0D0)                    *
  54 C  *             QCDL4  = QCD scale in GeV for four flavours           *
  55 C  *             QCDL5  = QCD scale in GeV for five flavours           *
  56 C  *                      corresponding to QCDL4                       *
  57 C  *             XMIN   = minimal allowed x value                      *
  58 C  *             XMAX   = maximal allowed x value                      *
  59 C  *             Q2MIN  = minimal allowed Q**2 value                   *
  60 C  *             Q2MAX  = maximal allowed Q**2 value                   *
  61 C  *                                                                   *
  62 C  *   for each set of structure fuction.                              *
  63 C  *                                                                   *
  64 C  *   The internal COMMON blocks                                      *
  65 C  *                                                                   *
  66 C  *   COMMON/W50511/ NPTYPE,NGROUP,NSET,MODE,NFL,LO,TMAS              *
  67 C  *   COMMON/W50512/ QCDL4,QCDL5                                      *
  68 C  *   COMMON/W50513/ XMIN,XMAX,Q2MIN,Q2MAX                            *
  69 C  *                                                                   *
  70 C  *   are filled then by the subroutine PDFSET.                       *
  71 C  *                                                                   *
  72 C  *                                                                   *
  73 C  *     Note: STRUCTM returns X * parton distribution function !      *
  74 C  *                                                                   *
  75 C  *                                                                   *
  76 C  *     Author:   H. Plothow-Besch                                    *
  77 C  *               CERN-PPE, CH - 1211 Geneva 23, Switzerland          *
  78 C  *                                                                   *
  79 C  *     Please return any problems, questions, suggestions            *
  80 C  *     to the author                                                 *
  81 C  *                                                                   *
  82 C  *********************************************************************
  83 C
  84 C
  85 #include "pdf/impdp.inc"
  86 C
  87 #include "pdf/w5051p1.inc"
  88 #include "pdf/w5051p2.inc"
  89 #include "pdf/w5051p7.inc"
  90 #include "pdf/w50510.inc"
  91 #include "pdf/w50511.inc"
  92 #include "pdf/w50512.inc"
  93 #include "pdf/w50513.inc"
  94 #include "pdf/w50514.inc"
  95 #include "pdf/w50514w.inc"
  96 #include "pdf/w50515.inc"
  97 #include "pdf/w50516.inc"
  98 #include "pdf/w50517.inc"
  99 #include "pdf/w50519.inc"
 100 #include "pdf/w505120.inc"
 101 #include "pdf/w505121.inc"
 102       CHARACTER*20 PARM(NCHDIM)
 103 #if defined(CERNLIB_DOUBLE)
 104       DOUBLE PRECISION
 105 #endif
 106 #if defined(CERNLIB_SINGLE)
 107       REAL
 108 #endif
 109      +       VAL(NCHDIM)
 110       DATA ZEROD/0.D0/,ONED/1.D0/,TWOD/2.D0/
 111       SAVE /W50514/, /W50514W/, /W50516/
 112 C.
 113 #include "pdf/w50511c.inc"
 114 C.
 115 C User wants new version (4.0 or bigger) of PDFLIB format
 116       IF (IFLSET.NE.1) THEN
 117          IF(FIRST) THEN
 118          WRITE(N6,*) ' Warning : NO initialisation via PDFSET made !!'
 119          WRITE(N6,*)
 120      +   '           ALL Parameters set to default (Nucleon PDFs) !!'
 121          ENDIF
 122          NPTYPE = LPTYPE
 123          NGROUP = LGROUP
 124          NSET   = LNSET
 125 C
 126          PARM(1) = 'Nptype'
 127          VAL(1)  = NPTYPE
 128          PARM(2) = 'Ngroup'
 129          VAL(2)  = NGROUP
 130          PARM(3) = 'Nset'
 131          VAL(3)  = NSET
 132 C
 133          CALL PDFSET(PARM,VAL)
 134       ENDIF
 135 C.
 136 C User wants old version (3.0 or less) of PDFLIB format
 137       IF(.NOT.NEWVER) THEN
 138         IF (MODE .GE.0 .AND. MODE .LE.MODEMX) THEN
 139            IF(MODE.EQ.0) THEN
 140              NPTYPE = LPTYPO
 141              NGROUP = LGROPO
 142              NSET   = LNSETO
 143            ELSE
 144              NPTYPE = NPTYCR(MODE)
 145              NGROUP = NGROCR(MODE)
 146              NSET   = NSETCR(MODE)
 147 C   Check on validity of parameter values
 148              IF (NPTYPE.LT.0 .OR. NGROUP.LT.0 .OR. NSET.LT.0) THEN
 149                 IF(FIRST) THEN
 150                 WRITE(N6,*) ' PDFLIB  : MODE value INCORRECT, MODE = ',
 151      +          MODE
 152                WRITE(N6,*) ' Warning : MODE value set to OLD default !!'
 153                 ENDIF
 154                 NPTYPE = LPTYPO
 155                 NGROUP = LGROPO
 156                 NSET   = LNSETO
 157              ENDIF
 158            ENDIF
 159         ENDIF
 160       ENDIF
 161 C.
 162 C... Define printer
 163            IF(N6.LE.0) N6 = L6
 164 C
 165         DUPV = ZEROD
 166         DDNV = ZEROD
 167         DUSEA = ZEROD
 168         DDSEA = ZEROD
 169         DSTR = ZEROD
 170         DCHM = ZEROD
 171         DBOT = ZEROD
 172         DTOP = ZEROD
 173         DGL  = ZEROD
 174 C
 175         ZUPV = ZEROD
 176         ZDNV = ZEROD
 177         ZUSEA = ZEROD
 178         ZDSEA = ZEROD
 179         ZSTR = ZEROD
 180         ZCHM = ZEROD
 181         ZBOT = ZEROD
 182         ZTOP = ZEROD
 183         ZGL  = ZEROD
 184 C
 185         DX  = X
 186         DQ  = SQRT(Q2)
 187         DQ2 = Q2
 188         IF (NPTYPE.EQ.3) THEN
 189             DP2 = P2
 190             IP2 = IP
 191         ELSE
 192             DP2 = ZEROD
 193             IP2 = 0
 194         ENDIF
 195 C.
 196         IF (DX.LE.ZEROD .OR. DX.GE.ONED) THEN
 197            WRITE(N6,*) ' PDFLIB  : Nptype = ',NPTYPE,',   Ngroup = ',
 198      +                 NGROUP,',   Nset = ',NSET
 199            WRITE(N6,*)
 200      +     ' Error   : X value outside physical range , X = ',DX
 201            GOTO 100
 202         ENDIF
 203         WTXMIN = WTXMIN + PDFWGT
 204         IF (DX.LT.XMIN) THEN
 205            WXMIN = WXMIN + PDFWGT
 206            IF(IFLPRT.GE.3) THEN
 207               WRITE(N6,*) ' PDFLIB  : Nptype = ',NPTYPE,',   Ngroup = ',
 208      +                 NGROUP,',   Nset = ',NSET
 209               WRITE(N6,*)
 210      +        ' Error   : X value smaller allowed range , X = ',DX
 211            ENDIF
 212         ENDIF
 213         WTXMAX = WTXMAX + PDFWGT
 214         IF (DX.GT.XMAX) THEN
 215            WXMAX = WXMAX + PDFWGT
 216            IF(IFLPRT.GE.3) THEN
 217               WRITE(N6,*) ' PDFLIB  : Nptype = ',NPTYPE,',   Ngroup = ',
 218      +                 NGROUP,',   Nset = ',NSET
 219               WRITE(N6,*)
 220      +        ' Error   : X value bigger  allowed range , X = ',DX
 221            ENDIF
 222            GOTO 100
 223         ENDIF
 224         WTQ2MIN = WTQ2MIN + PDFWGT
 225         IF (DQ2.LT.Q2MIN) THEN
 226            WQ2MIN = WQ2MIN + PDFWGT
 227            IF(IFLPRT.GE.3) THEN
 228               WRITE(N6,*) ' PDFLIB  : Nptype = ',NPTYPE,',   Ngroup = ',
 229      +                 NGROUP,',   Nset = ',NSET
 230               WRITE(N6,*)
 231      +      ' Error   : SCALE value smaller allowed range , Q**2 = ',DQ2
 232            ENDIF
 233         ENDIF
 234         WTQ2MAX = WTQ2MAX + PDFWGT
 235         IF (DQ2.GT.Q2MAX) THEN
 236            WQ2MAX = WQ2MAX + PDFWGT
 237            IF(IFLPRT.GE.3) THEN
 238               WRITE(N6,*) ' PDFLIB  : Nptype = ',NPTYPE,',   Ngroup = ',
 239      +                 NGROUP,',   Nset = ',NSET
 240               WRITE(N6,*)
 241      +       ' Error   : SCALE value bigger allowed range , Q**2 = ',DQ2
 242            ENDIF
 243         ENDIF
 244 C
 245       IF (FIRST) WRITE(N6,*) ' '
 246       IF (FIRST) WRITE(N6,*) ' '
 247 C Call default structure functions set
 248       IF    (NPTYPE.EQ.0 .OR. NGROUP.EQ.0 .OR. NSET.EQ.0) THEN
 249 C       IF (FIRST) WRITE(N6,*)
 250 C     + ' Nucleon PDFs :  GRV Set HO Structure Functions'
 251 C          IF (FIRST) WRITE(N6,*)
 252 C     + '                 Ngroup = ',NGROUP,',   Nset = ',NSET
 253 C       CALL GRVHO(DX,DQ,DUPV,DDNV,DUSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 254 C       DDSEA = DUSEA
 255 C       GOTO 100
 256           IF (FIRST) WRITE(N6,*)
 257      + ' Nucleon PDFs :  MRS Set (G) (L255-MSb) Structure Functions'
 258           IF (FIRST) WRITE(N6,*)
 259      + '                 Ngroup = ',NGROUP,',   Nset = ',NSET
 260           CALL SFMRSG(DX,DQ,DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DGL)
 261           DTOP=ZEROD
 262           GOTO 100
 263       ENDIF
 264 C Start with NUCLEON structure functions
 265       IF(NPTYPE.EQ.1 .OR. NPTYPE.EQ.2) THEN
 266          CALL STRUCTM(DX,DQ,
 267      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 268       ENDIF
 269 C Now start PHOTON structure functions
 270       IF(NPTYPE.EQ.3) THEN
 271       IF(NGROUP.LE.4) THEN
 272          CALL STRUCTM(DX,DQ,
 273      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 274       ELSEIF(NGROUP.EQ.5) THEN
 275         IF(NSET.LE.3) THEN
 276          CALL STRUCTM(DX,DQ,
 277      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 278         ELSEIF(NSET.EQ.4) THEN
 279           IF (FIRST) WRITE(N6,*)
 280      + ' Photon PDFs :  GRS-G Set LO Structure Functions'
 281           IF (FIRST) WRITE(N6,*)
 282      + '                Ngroup = ',NGROUP,',   Nset = ',NSET
 283           CALL GRVGALO(DX,DQ,ZUPV,ZDNV,ZUSEA,ZDSEA,ZSTR,DCHM,DBOT,ZGL)
 284           CALL GRSGALO(DX,DQ2,DP2,
 285      +                     DUPV,DDNV,DUSEA,DDSEA,DSTR,ZCHM,ZBOT,DGL)
 286           DTOP=ZEROD
 287           GOTO 100
 288         ELSEIF(NSET.GE.5) THEN
 289           WRITE(N6,*) ' Photon PDFs :  Ngroup = ',NGROUP,
 290      +             ',   Nset = ',NSET,
 291      +             ',  Structure Functions not yet exsistent'
 292           STOP
 293         ENDIF
 294       ELSEIF(NGROUP.GE.6 .AND. NGROUP.LE.8) THEN
 295          CALL STRUCTM(DX,DQ,
 296      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 297       ELSEIF(NGROUP.EQ.9) THEN
 298         IF(NSET.EQ.1) THEN
 299           IF (FIRST) WRITE(N6,*)
 300      + ' Photon PDFs :  SaS-G 95 Set 1D Structure Functions'
 301           IF (FIRST) WRITE(N6,*)
 302      + '                Ngroup = ',NGROUP,',   Nset = ',NSET
 303           CALL SFSAS11(DX,DQ2,DP2,
 304      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 305           GOTO 100
 306         ELSEIF(NSET.EQ.2) THEN
 307           IF (FIRST) WRITE(N6,*)
 308      + ' Photon PDFs :  SaS-G 95 Set 1M Structure Functions'
 309           IF (FIRST) WRITE(N6,*)
 310      + '                Ngroup = ',NGROUP,',   Nset = ',NSET
 311           CALL SFSAS12(DX,DQ2,DP2,
 312      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 313           GOTO 100
 314         ELSEIF(NSET.EQ.3) THEN
 315           IF (FIRST) WRITE(N6,*)
 316      + ' Photon PDFs :  SaS-G 95 Set 2D Structure Functions'
 317           IF (FIRST) WRITE(N6,*)
 318      + '                Ngroup = ',NGROUP,',   Nset = ',NSET
 319           CALL SFSAS13(DX,DQ2,DP2,
 320      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 321           GOTO 100
 322         ELSEIF(NSET.EQ.4) THEN
 323           IF (FIRST) WRITE(N6,*)
 324      + ' Photon PDFs :  SaS-G 95 Set 2M Structure Functions'
 325           IF (FIRST) WRITE(N6,*)
 326      + '                Ngroup = ',NGROUP,',   Nset = ',NSET
 327           CALL SFSAS14(DX,DQ2,DP2,
 328      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 329           GOTO 100
 330         ELSEIF(NSET.EQ.5) THEN
 331           IF (FIRST) WRITE(N6,*)
 332      + ' Photon PDFs :  SaS-G 96 Set 1D Structure Functions'
 333           IF (FIRST) WRITE(N6,*)
 334      + '                Ngroup = ',NGROUP,',   Nset = ',NSET
 335           CALL SFSAS21(DX,DQ2,DP2,IP2,
 336      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 337           GOTO 100
 338         ELSEIF(NSET.EQ.6) THEN
 339           IF (FIRST) WRITE(N6,*)
 340      + ' Photon PDFs :  SaS-G 96 Set 1M Structure Functions'
 341           IF (FIRST) WRITE(N6,*)
 342      + '                Ngroup = ',NGROUP,',   Nset = ',NSET
 343           CALL SFSAS22(DX,DQ2,DP2,IP2,
 344      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 345           GOTO 100
 346         ELSEIF(NSET.EQ.7) THEN
 347           IF (FIRST) WRITE(N6,*)
 348      + ' Photon PDFs :  SaS-G 96 Set 2D Structure Functions'
 349           IF (FIRST) WRITE(N6,*)
 350      + '                Ngroup = ',NGROUP,',   Nset = ',NSET
 351           CALL SFSAS23(DX,DQ2,DP2,IP2,
 352      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 353           GOTO 100
 354         ELSEIF(NSET.EQ.8) THEN
 355           IF (FIRST) WRITE(N6,*)
 356      + ' Photon PDFs :  SaS-G 96 Set 2M Structure Functions'
 357           IF (FIRST) WRITE(N6,*)
 358      + '                Ngroup = ',NGROUP,',   Nset = ',NSET
 359           CALL SFSAS24(DX,DQ2,DP2,IP2,
 360      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 361           GOTO 100
 362         ELSEIF(NSET.GE.9) THEN
 363           WRITE(N6,*) ' Photon PDFs :  Ngroup = ',NGROUP,
 364      +             ',   Nset = ',NSET,
 365      +             ',  Structure Functions not yet exsistent'
 366           STOP
 367         ENDIF
 368       ELSE
 369         WRITE(N6,*)' PHOTON Structure function call for unknown GROUP ',
 370      +  NGROUP,',   and unknown NSET ',NSET
 371         STOP
 372       ENDIF
 373       ENDIF
 374   100 IF(FIRST) WRITE(N6,*)
 375      +' ----------------------------------------------------------------
 376      +----------------------'
 377       IF (FIRST) FIRST = .FALSE.
 378 C
 379       UPV = MAX( ZEROD,DUPV)
 380       DNV = MAX( ZEROD,DDNV)
 381       USEA = MAX( ZEROD,DUSEA)
 382       DSEA = MAX( ZEROD,DDSEA)
 383       STR = MAX( ZEROD,DSTR)
 384       CHM = MAX( ZEROD,DCHM)
 385       BOT = MAX( ZEROD,DBOT)
 386       TOP = MAX( ZEROD,DTOP)
 387       GL  = MAX( ZEROD,DGL)
 388 C
 389       RETURN
 390       END