PDF/tpdf/tpdfupvo.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.2  1996/10/30 08:32:59  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 PDFUPVO
  14 C   define loop parameters (= maximal number of available PDF sets)
  15 C+SEQ, W5051P2.
  16       PARAMETER (MODEMX = 281)
  17 C   define HBOOK settings
  18       PARAMETER (NHBMEM = 500000)
  19       COMMON /PAWC/ HMEM(NHBMEM)
  20       PARAMETER (NB=900, ID=  0)
  21 C   define DOUBLE PRECISION variables for calling sequences
  22 #include "pdf/expdp.inc"
  23      +       DX,DSCALE,DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL,
  24      +       ALF,ALPHAS2
  25       REAL    X, SCALE, UPV, DNV, USEA, DSEA, STR, CHM, BOT, TOP, GL
  26 #include "pdf/w50516.inc"
  27       CHARACTER*20 PARM(20)
  28 #include "pdf/expdp.inc"
  29      +       VAL(20)
  30 C
  31       DATA SCALE/80.140/
  32       DATA X00/0.002/, DX0/0.001/
  33 C
  34       CALL HLIMIT(NHBMEM)
  35 C
  36       DSCALE=SCALE
  37 C   loop over all existing sets of proton structure functions (SF)
  38       DO 20 ISTRUC=0,MODEMX
  39 C   skip obsolete (or non existing) sets of SF
  40       IF(ISTRUC.EQ. 19                    ) GOTO 20
  41       IF(ISTRUC.GE. 48 .AND. ISTRUC.LE. 49) GOTO 20
  42       IF(ISTRUC.GE. 61 .AND. ISTRUC.LE. 69) GOTO 20
  43       IF(ISTRUC.EQ. 74                    ) GOTO 20
  44       IF(ISTRUC.GE. 76 .AND. ISTRUC.LE. 79) GOTO 20
  45       IF(ISTRUC.GE. 81 .AND. ISTRUC.LE.105) GOTO 20
  46       IF(ISTRUC.GE.108 .AND. ISTRUC.LE.119) GOTO 20
  47       IF(ISTRUC.GE.123 .AND. ISTRUC.LE.171) GOTO 20
  48       IF(ISTRUC.GE.174 .AND. ISTRUC.LE.179) GOTO 20
  49       IF(ISTRUC.GE.183 .AND. ISTRUC.LE.205) GOTO 20
  50       IF(ISTRUC.GE.208 .AND. ISTRUC.LE.209) GOTO 20
  51       IF(ISTRUC.GE.214 .AND. ISTRUC.LE.219) GOTO 20
  52       IF(ISTRUC.GE.223 .AND. ISTRUC.LE.229) GOTO 20
  53       IF(ISTRUC.GE.233 .AND. ISTRUC.LE.270) GOTO 20
  54       IF(ISTRUC.GE.274 .AND. ISTRUC.LE.279) GOTO 20
  55 C   book histograms for each set of SF separately
  56       CALL HBOOK1(ID+ISTRUC,'U Valence$',NB,0.0015,0.9015,0.)
  57 C   force label printing for each set of SF (not only 1st)
  58       FIRST = .TRUE.
  59 C   select and set parameters
  60       PARM(1) = 'Mode'
  61       VAL(1)  = ISTRUC
  62       CALL PDFSET(PARM,VAL)
  63 C   loop over all x bins
  64       DO 10 I=1,NB
  65         X= X00 +  (I-1)*DX0
  66         DX=X
  67         IF(X.LT.0.0015 .OR. X.GT.0.9015) GOTO 10
  68        CALL STRUCTM(DX,DSCALE,
  69      +                    DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
  70         UPV=DUPV
  71         IF(X.GT.0.499 .AND. X.LE.0.500) WRITE(6,1000) X,SCALE,UPV
  72  1000   FORMAT(/,'  X= ',F6.4,'  Q= ',F6.3,'  UPV= ',F8.4)
  73         CALL HF1(ID+ISTRUC,X,UPV)
  74  10   CONTINUE
  75 C   get alpha(s) for selected set of SF at Q = SCALE
  76       ALF = ALPHAS2(DSCALE)
  77       WRITE(6,1001) ISTRUC,DSCALE,ALF
  78  1001 FORMAT(/,'  Mode = ',I3,'   SCALE = ',F8.4,'   alpha(s) = ',F6.4)
  79 C   get error summary for each set of SF
  80       CALL PDFSTA
  81  20   CONTINUE
  82 C
  83       STOP
  84       END