]>
Commit | Line | Data |
---|---|---|
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 | |
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 |