source: trunk/MagicSoft/Simulation/Corsika/Mmcs/utqval.f@ 4155

Last change on this file since 4155 was 286, checked in by harald, 25 years ago
This is the start point for further developments of the Magic Monte Carlo Simulation written by Jose Carlos Gonzales. Now it is under control of one CVS repository for the whole collaboration. Everyone should use this CVS repository for further developments.
File size: 4.7 KB
Line 
1 SUBROUTINE UTQVAL(Q,NEND)
2
3C-----------------------------------------------------------------------
4C UT(ILITY ROUTINE) VAL(ENCE QUARK STRUCTURE FUNCTION)
5C
6C VALENCE QUARK STRUCTURE FUNCTION
7C RETURNS INTEGRAL (XVA(1)->XVA(I)) FU(Z) DZ
8C THIS INTEGRAL IS ONLY CALCULATED FOR SMALL VALUES OF XVA UP TO 25
9C TIMES THE VALUE OF XCUT. FOR LARGER VALUES THE TABULATED VALUES OF
10C DATASET 'VENUSDAT' ARE TAKEN AND CORRECTED BY THE CONSTANT SHIFT
11C DELTA0 (FOR HADRONS) OR DELTA1 (FOR PIONS).
12C
13C THIS SUBROUTINE IS CALLED FROM VENLNK
14C
15C DESIGN : D. HECK IK3 FZK KARLSRUHE
16C-----------------------------------------------------------------------
17
18*KEEP,RUNPAR.
19 COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
20 * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
21 * MONIOU,MDEBUG,NUCNUC,
22 * CETAPE,
23 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
24 * N1STTR,MDBASE,
25 * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
26 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
27 * ,GHEISH,GHESIG
28 COMMON /RUNPAC/ DSN,HOST,USER
29 DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
30 REAL STEPFC
31 INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
32 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
33 * N1STTR,MDBASE
34 INTEGER CETAPE
35 CHARACTER*79 DSN
36 CHARACTER*20 HOST,USER
37
38 LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
39 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
40 * ,GHEISH,GHESIG
41*KEND.
42
43 PARAMETER (NSTRU=2049)
44 COMMON /CIPIO/ IPIO
45 COMMON /FILES/ IFCH,IFDT,IFHI,IFMT,IFOP
46 COMMON /PARO1/ AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
47 * ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
48 * ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
49 * ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
50 * ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
51 * ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
52 * ,WTSTEP,XCUT
53 * ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
54 * ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
55 * ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
56 * ,NSTTAU,NTRYMX,NUMTAU
57 COMMON /STRU2/ DELTA0,DELTA1,QSEH(NSTRU),QSEPI(NSTRU)
58 * ,QVAH(NSTRU),QVAPI(NSTRU),XSE(NSTRU),XVA(NSTRU)
59
60 DIMENSION Y0(9),Y1(9),Q(NEND)
61C-----------------------------------------------------------------------
62
63 IF ( DEBUG ) WRITE(MDEBUG,*) 'UTQVAL: IPIO,NEND=',IPIO,NEND
64
65 XCUT2 = XCUT**2
66 Q(1) = 0.
67 Z = XVA(1)
68 DENOMI = 1. / SQRT(Z**2 + XCUT2)
69
70 IF ( IPIO .EQ. 0 ) THEN
71C CALCULATE THE FIRST NEND VALUES OF STRUCTURE FUNCTION FOR HADRONS
72 Y0(1) = 0.
73 DO 3 I=2,NEND
74 FACT = (XVA(I) - Z) * 0.125
75 DO 2 J=2,8
76 Z = Z + FACT
77 DENOMI = 1. / SQRT(Z**2 + XCUT2)
78 Y0(J) = (1.-Z)**3.46 * Z**.419 * (2.74793064*Z + 0.62452969)
79 * * DENOMI
80 2 CONTINUE
81 Z = XVA(I)
82 DENOMI = 1. / SQRT(Z**2 + XCUT2)
83 Y0(9) = (1.-Z)**3.46 * Z**.419 * (2.74793064*Z + 0.62452969)
84 * * DENOMI
85C INTEGRATION AFTER BODE'S RULE (ABRAMOWITZ + STEGUN, HANDBOOK OF
86C MATHEMATICAL FUNCTIONS, DOVER PUBLICATIONS (1970), FORMULA 25.4.18)
87 Q(I) = 2.8218694E-4 * FACT * ( 989. * (Y0(1) + Y0(9))
88 * + 5888. * (Y0(2) + Y0(8)) - 928. * (Y0(3) + Y0(7))
89 * + 10496. * (Y0(4) + Y0(6)) - 4540. * Y0(5) )
90 * + Q(I-1)
91 Y0(1) = Y0(9)
92 3 CONTINUE
93
94 ELSE
95C CALCULATE THE FIRST NEND VALUES OF STRUCTURE FUNCTION FOR PIONS
96 Y1(1) = 0.
97 DO 5 I=2,NEND
98 FACT = (XVA(I) - Z) * 0.125
99 DO 4 J=2,8
100 Z = Z + FACT
101 DENOMI = 1. / SQRT(Z**2 + XCUT2)
102 Y1(J) = (1.-Z)**0.7 * Z**.4 * DENOMI
103 4 CONTINUE
104 Z = XVA(I)
105 DENOMI = 1. / SQRT(Z**2 + XCUT2)
106 Y1(9) = (1.-Z)**0.7 * Z**.4 * DENOMI
107C INTEGRATION AFTER BODE'S RULE (ABRAMOWITZ + STEGUN, HANDBOOK OF
108C MATHEMATICAL FUNCTIONS, DOVER PUBLICATIONS (1970), FORMULA 25.4.18)
109 Q(I) = 2.8218694E-4 * FACT * ( 989. * (Y1(1) + Y1(9))
110 * + 5888. * (Y1(2) + Y1(8)) - 928. * (Y1(3) + Y1(7))
111 * + 10496. * (Y1(4) + Y1(6)) - 4540. * Y1(5) )
112 * * 0.1730725 + Q(I-1)
113 Y1(1) = Y1(9)
114 5 CONTINUE
115 ENDIF
116
117 RETURN
118 END
Note: See TracBrowser for help on using the repository browser.