PDF/tpdf/tpdfupv.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.2  1996/10/30 08:32:57  cernlib
   6 * Version 7.04
   7 *
   8 * Revision 1.1.1.1  1996/04/12 15:30:18  plothow
   9 * Version 7.01
  10 *
  11 *
  12 #include "pdf/pilot.h"
  13       PROGRAM PDFUPV
  14 C
  15       PARAMETER (LFLPRT = 2)
  16 #include "pdf/w5051p2.inc"
  17 #include "pdf/w5051p7.inc"
  18 #include "pdf/w50510.inc"
  19 #include "pdf/w50511.inc"
  20 #include "pdf/w505110.inc"
  21 #include "pdf/w505120.inc"
  22 #include "pdf/w505122.inc"
  23 C   define HBOOK settings
  24       PARAMETER (NHBMEM = 500000)
  25       COMMON /PAWC/ HMEM(NHBMEM)
  26       PARAMETER (NB=900, ID=  0)
  27 C   define DOUBLE PRECISION variables for calling sequences
  28 #include "pdf/expdp.inc"
  29      +       DX,DSCALE,DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL,
  30      +       ALF,ALPHAS2
  31       REAL    X, SCALE, UPV, DNV, USEA, DSEA, STR, CHM, BOT, TOP, GL
  32 #include "pdf/w50516.inc"
  33       CHARACTER*20 PARM(NCHDIM)
  34 #include "pdf/expdp.inc"
  35      +       VAL(NCHDIM)
  36 C
  37       DATA SCALE/80.140/
  38       DATA X00/0.002/, DX0/0.001/
  39 C
  40       N6 = L6
  41       IFLPRT = LFLPRT
  42 C
  43       CALL HLIMIT(NHBMEM)
  44 C
  45       DSCALE=SCALE
  46 C
  47 C First call to PDFSET to initialize COMMON/W505120/
  48       PARM(1) = 'Init0'
  49       VAL(1)  = 0.D0
  50       CALL PDFSET(PARM,VAL)
  51 C   loop over all existing sets of Nucleon structure functions (SF)
  52       NPTYPE = 1
  53       NSF = 0
  54       DO IGR = 1,NGRMAX
  55          IF(NPGSMX(NPTYPE,IGR).EQ.0) GOTO 30
  56          DO ISET = 1,NPGSMX(NPTYPE,IGR)
  57             WRITE (N6,*) ' =============================================
  58      +================================================================='
  59             NSF = NSF + 1
  60 C   book histograms for each set of SF separately
  61             CALL HBOOK1(ID+NSF,'U Valence$',NB,0.0015,0.9015,0.)
  62 C   force label printing for each set of SF (not only 1st)
  63             FIRST = .TRUE.
  64 C   select and set parameters
  65             PARM(1) = 'Nptype'
  66             VAL(1)  = NPTYPE
  67             PARM(2) = 'Ngroup'
  68             VAL(2)  = IGR
  69             PARM(3) = 'Nset'
  70             VAL(3)  = ISET
  71             CALL PDFSET(PARM,VAL)
  72 C   loop over all x bins
  73             DO 10 I=1,NB
  74                X= X00 +  (I-1)*DX0
  75                DX=X
  76                IF(X.LT.0.0015 .OR. X.GT.0.9015) GOTO 10
  77                CALL STRUCTM(DX,DSCALE,
  78      +                    DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
  79                UPV=DUPV
  80               IF(X.GT.0.499 .AND. X.LE.0.500) WRITE(N6,1000) X,SCALE,UPV
  81  1000          FORMAT(/,'  X= ',F6.4,'  Q= ',F6.3,'  UPV= ',F8.4)
  82                CALL HF1(ID+NSF,X,UPV)
  83  10         CONTINUE
  84 C   get alpha(s) for selected set of SF at Q = SCALE
  85             ALF = ALPHAS2(DSCALE)
  86            WRITE(N6,4000) NPTYPE,NGROUP,NSET,SFNAME(NPTYPE,NGROUP,NSET),
  87      +                    MODECR(NPTYPE,NGROUP,NSET),NSF
  88             WRITE(N6,4001) DSCALE,ALF
  89  4000       FORMAT(/,'  Nptype = ',I1,'  Ngroup = ',I1,
  90      +               '  Nset = ',I2,'  Name  = "',A8,
  91      +               '"  CrMode = ',I3,'  HBId = ',I3)
  92  4001       FORMAT(1H ,' Scale  = ',F8.4,'  alpha(s) = ',F6.4)
  93 C   get error summary for each set of SF
  94             CALL PDFSTA
  95    20       CONTINUE
  96          ENDDO
  97    30    CONTINUE
  98       ENDDO
  99 C
 100       STOP
 101       END