This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / PDF / tpdf / tpdfupvo.F
CommitLineData
fe4da5cc 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
14C define loop parameters (= maximal number of available PDF sets)
15C+SEQ, W5051P2.
16 PARAMETER (MODEMX = 281)
17C define HBOOK settings
18 PARAMETER (NHBMEM = 500000)
19 COMMON /PAWC/ HMEM(NHBMEM)
20 PARAMETER (NB=900, ID= 0)
21C 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)
30C
31 DATA SCALE/80.140/
32 DATA X00/0.002/, DX0/0.001/
33C
34 CALL HLIMIT(NHBMEM)
35C
36 DSCALE=SCALE
37C loop over all existing sets of proton structure functions (SF)
38 DO 20 ISTRUC=0,MODEMX
39C 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
55C book histograms for each set of SF separately
56 CALL HBOOK1(ID+ISTRUC,'U Valence$',NB,0.0015,0.9015,0.)
57C force label printing for each set of SF (not only 1st)
58 FIRST = .TRUE.
59C select and set parameters
60 PARM(1) = 'Mode'
61 VAL(1) = ISTRUC
62 CALL PDFSET(PARM,VAL)
63C 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
75C 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)
79C get error summary for each set of SF
80 CALL PDFSTA
81 20 CONTINUE
82C
83 STOP
84 END