source: trunk/MagicSoft/Simulation/Corsika/Mmcs/venini.f

Last change on this file 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: 33.1 KB
Line 
1 SUBROUTINE VENINI
2
3C-----------------------------------------------------------------------
4C VEN(US) INI(TIALISATION)
5C
6C FIRST INITIALIZATION OF VENUS ARRAYS AND PARAMETERS
7C THIS SUBROUTINE IS CALLED FROM START
8C
9C DESIGN : D. HECK IK3 FZK KARLSRUHE
10C-----------------------------------------------------------------------
11
12*KEEP,AIR.
13 COMMON /AIR/ COMPOS,PROBTA,AVERAW,AVOGAD
14 DOUBLE PRECISION COMPOS(3),PROBTA(3),AVERAW,AVOGAD
15*KEEP,PAM.
16 COMMON /PAM/ PAMA,SIGNUM
17 DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
18*KEEP,RANDPA.
19 COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR
20 DOUBLE PRECISION FAC,U1,U2
21 REAL RD(3000)
22 INTEGER ISEED(103,10),NSEQ
23 LOGICAL KNOR
24*KEEP,RUNPAR.
25 COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
26 * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
27 * MONIOU,MDEBUG,NUCNUC,
28 * CETAPE,
29 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
30 * N1STTR,MDBASE,
31 * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
32 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
33 * ,GHEISH,GHESIG
34 COMMON /RUNPAC/ DSN,HOST,USER
35 DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
36 REAL STEPFC
37 INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
38 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
39 * N1STTR,MDBASE
40 INTEGER CETAPE
41 CHARACTER*79 DSN
42 CHARACTER*20 HOST,USER
43
44 LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
45 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
46 * ,GHEISH,GHESIG
47*KEEP,VENPAR.
48 COMMON /VENPAR/ PARVAL,NPARAM,PARCHA
49 REAL PARVAL(100)
50 INTEGER NPARAM
51 CHARACTER*6 PARCHA(100)
52*KEEP,VENUS.
53 COMMON /VENUS/ ISH0,IVERVN,MTAR99,FVENUS,FVENSG
54 INTEGER ISH0,IVERVN,MTAR99
55 LOGICAL FVENUS,FVENSG
56*KEND.
57
58 PARAMETER (KOLLMX=2500)
59 PARAMETER (MXEPS=10)
60 PARAMETER (MXTAU=4)
61 PARAMETER (MXVOL=10)
62 PARAMETER (NGAU=129)
63 PARAMETER (NDEP=129)
64 PARAMETER (NDET=129)
65 PARAMETER (NPTF=129)
66 PARAMETER (NPTJ=129)
67 PARAMETER (NSTRU=2049)
68 COMMON /ACCUM/ AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
69 * ,NRPTL,NRSTR,NTEVT
70 COMMON /CDEN/ MASSNR,RMX,R0
71 COMMON /CGAU/ QGAU(NGAU),XGAU(NGAU)
72 COMMON /CIUTOT/ IUTOTC,IUTOTE
73 COMMON /CJINTC/ CLUST(MXTAU,MXVOL,MXEPS)
74 COMMON /CJINTD/ VOLSUM(MXTAU),VO2SUM(MXTAU),NCLSUM(MXTAU)
75 COMMON /CLEP/ ICINPU,IDSCAT
76 COMMON /CNSTA/ AINFIN,PI,PIOM,PROM
77 COMMON /COL/ BIMP,BMAX,COORD(4,KOLLMX),DISTCE(KOLLMX)
78 * ,QDEP(NDEP),QDET14(NDET),QDET16(NDET),QDET40(NDET)
79 * ,QDET99(NDET),RMPROJ,RMTARG(4),XDEP(NDEP)
80 * ,XDET14(NDET),XDET16(NDET),XDET40(NDET)
81 * ,XDET99(NDET)
82 * ,KOLL,LTARG,NORD(KOLLMX),NPROJ,NRPROJ(KOLLMX)
83 * ,NRTARG(KOLLMX),NTARG
84 COMMON /CPTF/ FPTFS,FPTFSS,FPTFU,FPTFUS,FPTFUU
85 * ,QPTFS(NPTF),QPTFSS(NPTF),QPTFU(NPTF),QPTFUS(NPTF)
86 * ,QPTFUU(NPTF),XPTF(NPTF)
87 COMMON /CPTJ/ QPTJ(NPTJ),XPTJ(NPTJ)
88 COMMON /CPTLU/ NPTLU
89 COMMON /CQUAMA / QUAMA
90 DOUBLE PRECISION SEEDC,SEEDI
91 COMMON /CSEED/ SEEDC,SEEDI
92 COMMON /CVSN/ IVERSN
93 COMMON /EPSCR/ EPSCRI
94 COMMON /FILES/ IFCH,IFDT,IFHI,IFMT,IFOP
95 COMMON /NEVNT/ NEVNT
96 COMMON /PARO1/ AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
97 * ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
98 * ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
99 * ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
100 * ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
101 * ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
102 * ,WTSTEP,XCUT
103 * ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
104 * ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
105 * ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
106 * ,NSTTAU,NTRYMX,NUMTAU
107 COMMON /PARO2/ AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
108 * ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
109 * ,YHAHA,YMXIMI,YPJTL
110 * ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
111 * ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
112 * ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
113 * ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
114 * ,MODSHO,NDECAX,NDECAY,NEVENT
115 COMMON /PARO3/ ASUHAX(7),ASUHAY(7),OMEGA,SIGPPD,SIGPPE,UENTRO
116 * ,IWZZZZ
117 COMMON /PARO4/ GRICEL,GRIDEL,GRIGAM,GRIRSQ,GRISLO
118 COMMON /PARO5/ DELEPS,DELVOL
119 COMMON /QUARKM/ SMAS,SSMAS,USMAS,UUMAS
120 COMMON /STRU2/ DELTA0,DELTA1,QSEH(NSTRU),QSEPI(NSTRU)
121 * ,QVAH(NSTRU),QVAPI(NSTRU),XSE(NSTRU),XVA(NSTRU)
122 COMMON /VENLIN/ PTQ1,PTQ2,PTQ3,QMUST1,QMUST2,QMUST3
123 * ,IDTABL(100)
124
125 EXTERNAL SDENSI,SGAU,SPTF,SPTJ
126C-----------------------------------------------------------------------
127
128 IF ( DEBUG ) WRITE(MDEBUG,*) 'VENINI:'
129
130 IFMT = MONIOU
131 IFCH = MDEBUG
132 ICHOIC = 2
133 NEVNT = 0
134
135C VERSION NUMBER
136C --------------
137 IVERSN=4125
138 IVERVN=IVERSN
139
140C FRAGMENTATION PARAMETERS/OPTIONS
141C --------------------------------
142C PROB. FOR U OR D QUARK PRODUCTION ( =(1-P_STRANGE)/2 ):
143 PUD=0.455
144C QQ-QQBAR PROBABILITY
145 PDIQUA=0.12
146C SPIN PROBABILITIES (FOR LIGHT AND HEAVY FLAVOURS):
147 PSPINL=0.50
148 PSPINH=0.75
149C ISOSPIN PROBABILITY:
150 PISPN=0.50
151C OPTION FOR P_T DISTRIBUTION (1=EXPONENTIAL,2=GAUSSIAN):
152 IOPTF=1
153C AVERAGE P_TRANSVERSE
154 PTF=0.40
155C STRING TENSION:
156 TENSN=1.0
157C STRING DECAY PARAMETER
158 PAREA=.60
159C THRESHOLD RESONANCE -> STRING
160 DELREM=1.0
161C CUTOFF FOR KMAXOR BEYOND WHICH PDIQ=0 IN SR JSPLIT
162 KUTDIQ=4
163C OPTION FOR BREAKING PROCEDURE (1=AMOR,2=SAMBA)
164 IOPBRK=1
165
166C PROTON-PROTON PARAMETERS/OPTIONS
167C --------------------------------
168C OPTION FOR QUARK P_T DISTRIBUTION (1=EXPONENTIAL,2=GAUSSIAN,3=POWE
169 IOPTQ=2
170C MEAN TRANSVERSE MOMENTUM OF QUARKS
171C (Q1+Q2*LN(E)+Q3*LN(E)**2, E=SQRT(S)):
172 PTQ1=0.260
173 PTQ2=0.
174 PTQ3=0.
175C PROBABILITY FOR SEMIHARD INTERACTION (NOT USED IF NEGATIVE):
176C PHARD=-1.0
177C CUTOFF PARAMETER FOR P_T DISTR. FOR SEMIHARD INTERACTIONS:
178 PTH=1.0
179C EFFECTIVE RATIO OF STRANGE SEA OVER U SEA:
180 RSTRAS=0.
181C EFFECTIVE CUTOFF MASS IN STRUCTURE FUNCTIONS:
182 CUTMSQ=2.0
183 CUTMSS=0.001
184C VALENCE QUARK FRACTION IN CASE OF DIFFRACTIVE INTERACTION
185 PVALEN=0.30
186C PHASE SPACE PARAMETERS:
187 DELMSS=0.300
188
189C GRIBOV-REGGE-THEORY PARAMETERS
190C ------------------------------
191C GAMMA (IN FM**2):
192 GRIGAM=3.64*0.04
193C R**2(IN FM**2):
194 GRIRSQ=3.56*0.04
195C DELTA=INTERCEPT OF REGGE TRAJECTORY-1:
196 GRIDEL=0.07
197C SLOPE OF REGGE TRAJECTORY (IN FM**2):
198 GRISLO=0.25*0.04
199C C (DETERMINES RELATIVE WEIGHT OF ELASTIC AND DIFFR CROSS SCTN):
200 GRICEL=1.5
201
202C NUCLEUS-NUCLEUS PARAMETERS
203C --------------------------
204C HARD CORE DISTANCE:
205 CORE=0.8
206C JPSI NUCLEON CROSS SECTION (FM**2):
207 SIGJ=0.2
208
209C RESCATTERING PARAMETERS
210C -----------------------
211C REACTION TIME:
212 TAUREA=1.5
213C OVERLAP PARAMETER (NOT USED IF NEGATIVE)
214 OVERLP=-1.0
215C BARYON RADIUS:
216 RADIAC=0.65
217C MESON RADIUS:
218 RADIAS=0.35
219C CRITICAL ENERGY DENSITY (<0 TO AVOID SECONDARY INTERACTIONS):
220 EPSCRI=1.0
221C BARYON ENERGY DENSITY
222 EPSBAR=2.0
223C INTERACTION MASS:
224 AMSIAC=0.8
225C OPTION TO CALL JINTA1 (1) OR JINTA2 (2)
226 IOJINT=2
227C PRINT OPTIONS
228 AMPRIF=0.
229 DELVOL=1.0
230 DELEPS=1.0
231
232C CLUSTER DECAY PARAMETERS/OPTIONS
233C --------------------------------
234C CORRELATION LENGTH
235C (CORLEN>1.0: FIRST FIX SHORT CLUSTER BREAKING
236 CORLEN=1.0
237C MINIMUM MASS
238 AMUSEG=3.0
239C BAG CONSTANT -1/4
240 BAG4RT=0.200
241C OPTION FOR ENTROPY CALCULATION:
242C IOPENT=0: ZERO ENTROPY
243C IOPENT=1: OSCILLATOR MODEL (0 FOR K.LE.UENTRO)
244C IOPENT=2: FERMI GAS WITH CONST VOLUME (0 FOR K.LE.UENTRO)
245C IOPENT=3: FERMI GAS WITH CONST DENSITY (0 FOR K.LE.UENTRO)
246C IOPENT=4: FERMI GAS WITH CONST VOLUME - NEW (0 FOR K.LE.UENTRO)
247C IOPENT=5: RESONANCE GAS (HAGEDORN) (0 FOR U.LE.UENTRO)
248 IOPENT=5
249 UENTRO=4.0
250 KENTRO=100000
251C DECAY TIME (COMOVING FRAME):
252 TAUNLL=1.0
253C OSCILLATOR QUANTUM
254 OMEGA=0.500
255
256C PRESENTLY NOT USED
257C ------------------
258
259C CLUSTER DECAY INITIALIZATIONS
260C -----------------------------
261C AVERAGE HADRON MASSES, TWO LOWEST MULTIPLETS (IF POSSIBLE):
262C N/DELTA,LAMBDA/SIGMA,XI,OMEGA,PI/RHO,KAON,DELTA:
263 ASUHAX(1)=1.134
264 ASUHAX(2)=1.301
265 ASUHAX(3)=1.461
266 ASUHAX(4)=1.673
267 ASUHAX(5)=0.6125
268 ASUHAX(6)=0.7915
269 ASUHAX(7)=1.2320
270C LOWEST MASSES:
271 ASUHAY(1)=0.940
272 ASUHAY(2)=1.200
273 ASUHAY(3)=1.322
274 ASUHAY(4)=1.673
275 ASUHAY(5)=0.1400
276 ASUHAY(6)=0.4977
277 ASUHAY(7)=1.2320
278
279C TECHNICAL PARAMETERS
280C --------------------
281C DELTA_ZETA FOR /C4PTL/...WEIPTL()
282 DLZETA=0.5
283C MIN TAU FOR SPACE-TIME EVOLUTION:
284 TAUMIN=0.
285C MAX TAU FOR SPACE-TIME EVOLUTION
286 TAUMAX=10.0
287C TAU STEPS FOR SPACE-TIME EVOTUTION (46+40)
288 NUMTAU=51
289C RANGE FOR PT DISTRIBUTION
290 PTMX=6.0
291C RANGE FOR GAUSS DISTRIBUTION
292 GAUMX=8.0
293C PARAMETER DETERMINING RANGE FOR DENSITY DISTRIBUTION
294 FCTRMX=10.0
295C TRY-AGAIN PARAMETER
296 NTRYMX=10
297C MAX TIME FOR JPSI EVOLUTION
298 TAUMX=20.0
299C TIME STEPS FOR JPSI EVOLUTION
300 NSTTAU=100
301
302C OPTIONS
303C -------
304C OPTION FOR MINIMUM ENERGY IN SJCGAM:
305C IOPENU = 1 : SUM OF HADRON MASSES
306C IOPENU = 2 : BAG MODEL CURVE WITH MINIMUM AT NONZERO STRANGEN.
307 IOPENU=1
308C PARAMETER THETA IN BERGER/JAFFE MASS FORMULA
309 THEMAS=0.51225
310C SEA PROBABILITY (IF .LT. 0. THEN CALCULATED FROM STRUCTURE FNCTS)
311 PROSEA=-1.0
312C INELASTIC PP CROSS SECTION (FM**2)
313C (IF NEGATIVE: CALCULATED FROM GRIBOV-REGGE-THEORY):
314CDH SIGPPI=-1.0
315C MULTISTRING PARAMETER (Q1+Q2*LN(E)+Q3*LN(E)**2, E=SQRT(S)):
316C (NOT USED IF RACPRO IS CALLED WITH 'GRI'-OPTION (DEFAULT))
317 QMUST1=0.50
318 QMUST2=0.
319 QMUST3=0.
320C ENTRO() CALCULATED (1) OR FROM DATA (2)
321 IENTRO=2
322C DUAL PARTON MODEL (1) OR NOT (ELSE)
323 IDPM=0
324C ANTIQUARK COLOR EXCHANGE (1) OR NOT (0):
325 IAQU=1
326C MINIMUM NUMBER OF VALENCE QUARKS:
327 NEQMN=-5
328C MAXIMUM NUMBER OF VALENCE QUARKS:
329 NEQMX=5
330C UPPER LIMIT FOR RAPIDITY INTERVAL FOR INTERMITTENCY ANALYSIS
331 YMXIMI=2.0
332C CLEAN /CPTL/ IF NCLEAN > 0 (EVERY NCLEAN_TH TIME STEP)
333 NCLEAN=0
334C TRAFO FROM PP-CM INTO LAB-SYSTEM (1) OR NOT (.NE.1)
335 LABSYS=1
336C MAXIMUM NUMBER OF COLLISIONS:
337 NCOLMX=1000
338C MAXIMUM RESONANCE SPIN (SPIN IN A GENARAL SENSE: MOD(/ID/,10))
339 MAXRES=99999
340C MOMENTUM RESCALING (1=YES):
341 IRESCL=1
342C NUE ENERGY
343 ELEPTI=43.00
344C MUE ENERGY
345 ELEPTO=26.24
346C MUE ANGLE
347 ANGMUE=3.9645/180.*3.1415926
348C JPSI TO BE PRODUCED (1) OR NOT (0):
349 JPSI=0
350C JPSI FINAL STATE INTERACTION (1) OR NOT (0):
351 JPSIFI=0
352C COLLISION TRIGGER (ONLY COLL BETWEEN KO1 AND KO2 ARE USED):
353 KO1KO2=00009999
354C PRINT OPTION:
355C ISH=14: CALL UTTIMA
356C ISH=15: PRINTS PTLS READ FROM DATA FILE IN SR VEANLY
357C ISH=16: PRINTS SEA PROB.
358C ISH=17: PRINTS RANDOM NUMBERS
359C ISH=18: SR JCLUDE, NO-PHASE-SPACE CLUSTERS
360C ISH=19: SR AINITL, CALL SMASSP
361C ISH=20: SR VEANLY, PRINTS EVT NR IF EVT IS ACCEPTED
362C ISH=21: CREATES HISTOGRAM FOR SEA DISTRIBUTION
363C ISH=22: SR JFRADE, MSG AFTER CALL UTCLEA
364C ISH=23: CALL JINTFP
365C ISH=24: CALL JINTCL
366C ISH=25: CALL JCHPRT
367C ISH=90,91,92,93,94,95: MORE AND MORE DETAILED MESSAGES.
368 IF ( DEBUG ) THEN
369 ISH = ISH0
370 ELSE
371 ISH = 0
372 ENDIF
373C PRINT OPTION:
374C ISHSUB=IJMN, IJ SPECIFIES LOCATION WHERE ISH=MN.
375C IJ=01: SR JCLUDE
376C IJ=02: SR JETGEN
377C IJ=03: SR JFRADE, STARTING BEFORE FRAGMENTATION
378C IJ=04: SR JDECAY
379C IJ=05: SR JDECAX
380C IJ=06: SR NUCOLL
381C IJ=07: SR NUCOGE+-
382C IJ=08: SR ASTORE
383C IJ=09: SR JFRADE, STARTING AFTER FRAGMENTATION
384C IJ=10: SR JFRADE, STARTING BEFORE DECAY
385C IJ=11: SR JFRADE, STARTING AFTER INTERACTIONS
386C IJ=12: SR JCENTR, ENTRO() IN DATA FORMAT
387C IJ=13: SR JCENTP
388C IJ=14: SR JDECAX IF CLUSTER DECAY
389C IJ=15: SR JSPLIT
390C IJ=16: SR JFRADE
391C IJ=17: SR RACPRO
392C IJ=18: SR UTCLEA
393C IJ=19: SR JINTA1, JINTA2, AFTER CALL UTCLEA
394C IJ=20: SR JDECAS
395C IJ=21: SR JDECAS (WITHOUT JDECAX)
396 ISHSUB=0
397C PRINT OPTION:
398C IF ISHEVT.NE.0: FOR EVT#.NE.ISHEVT ISH IS SET TO 0
399 ISHEVT=0
400C PRINT MARKS BETWEEN WHOM ISH IS SET TO ISH(INIT):
401 IPAGI=0
402C VERIFY OPTION FOR INPUT READING:
403 IVI=1
404C MAXIMUM IMPACT PARAMETER (BMAXIM=0=>CENTRAL):
405 BMAXIM=10000.
406C MINIMUM IMPACT PARAMETER:
407 BMINIM=0.
408C STORE ONLY STABLE PTL (0) OR ALSO PARENTS (1):
409 ISTMAX=0
410C RANDOM GENERATOR SEED
411 SEEDI=ISEED(1,1)
412 SEEDC=ISEED(2,1)+1.D9*ISEED(3,1)
413C SUPPRESSION (1) OR NOT OF MESSAGES
414 ISUP=0
415C SUPPRESSION OF CALLING JFRADE (0). JFRADE=FRAGM+DECAY+RESCATTERING
416 IFRADE=1
417C.. DECAY SUPPRESSION. NDECAY SPECIFIES WHICH RESONANCES ARE NOT DECAY
418C.. 0000001 : ALL RESONANCES
419C.. 0000010 : K_SHORT/LONG (+-20)
420C.. 0000100 : LAMBDA (+-2130)
421C.. 0001000 : SIGMA (+-1130,+-2230)
422C.. 0010000 : CASCADE (+-2330,+-1330)
423C.. 0100000 : OMEGA (+-3331)
424C.. 1000000 : PI0 (110)
425 NDECAY=1111110
426C.. DECAY SUPPRESSION. NDECAX SPECIFIES WHICH RESONANCES ARE NOT DECAY
427C.. 0000001 : JPSI
428C.. 0000010 : K_ZERO (+-230)
429C.. 0000100 : DELTA (+-1111,+-1121,+-1221,+-2221)
430C.. 0001000 : RHO,OMEGA,PHI (111,+-121,221,331)
431C.. 0010000 : ETA (220)
432C.. 0100000 : ETAPRIME (330)
433C.. 1000000 : A0 (112), A+- (+-122)
434 NDECAX=0010000
435C.. DECAY SUPPRESSION. NDECAW SPECIFIES WHICH RESONANCES ARE NOT DECAY
436C.. 0000001 : F0 (332)
437C.. 0000010 : K* (+-131,+-231)
438 NDECAW=0
439C FILL ZZZZ HISTOGRAMS (1) OR NOT (0)
440C IWZZZZ=0
441C FILL INTERMITTENCY HISTOGRAMS (1) OR NOT (0)
442C IMIHIS=0
443C FILL SPACE-TIME HISTOGRAMS (1) OR NOT (0)
444 ISPHIS=0
445C FILL CLUSTER HISTOGRAMS (1) OR NOT (0)
446C ICLHIS=0
447C FILL JPSI HISTOGRAMS (1) OR NOT (0)
448C IJPHIS=0
449C RHO/RHO+PHI RATIO
450 RHOPHI=0.5
451C WSPA: ALL PTLS (1) OR ONLY INTERACTING PTLS (ELSE)
452 ISPALL=1
453C TMIN IN WSPA
454 WTMINI=-3.0
455C T-STEP IN WSPA
456 WTSTEP=1.0
457C ONLY CENTRAL POINT (1) OR LONGITUDINAL DISTRIBUTION (ELSE) IN WSPA
458 IWCENT=0
459C QUARK MASSES
460 SMAS=0.
461 UUMAS=0.
462 USMAS=0.
463 SSMAS=0.
464
465C CONSTANTS (PROTON MASS, PION MASS, PI, INFINITE)
466C ---------
467C PROM=0.94
468 PROM=PAMA(14)
469C PIOM=0.14
470 PIOM=PAMA(8)
471 PI=3.141592654
472 AINFIN=1.E+30
473
474C INITIALIZATIONS
475C ---------------
476 LAPROJ=0
477 MAPROJ=0
478 LATARG=0
479 MAPROJ=0
480 IDPROJ=1120
481 IDTARG=1120
482 DO 6 I=1,99
483 PROB(I)=0.
484 ICBAC(I,1)=0
485 ICBAC(I,2)=0
486 ICFOR(I,1)=0
487 ICFOR(I,2)=0
488 6 CONTINUE
489 PNLL=0.
490
491C FEW INITIALIZATIONS FOR CROSS SECTION CALCULATIONS
492C --------------------------------------------------
493
494 IMSG=0
495 JERR=0
496 NTEVT=0
497 NREVT=0
498 NAEVT=0
499 NRSTR=0
500 NRPTL=0
501 INOIAC=0
502 ILAMAS=0
503 NPTLU=0
504 DO 44 ITAU = 1,MXTAU
505 VOLSUM(ITAU)=0.
506 VO2SUM(ITAU)=0.
507 NCLSUM(ITAU)=0
508 44 CONTINUE
509 DO 43 IEPS=1,MXEPS
510 DO 43 IVOL=1,MXVOL
511 DO 43 ITAU=1,MXTAU
512 CLUST(ITAU,IVOL,IEPS) = 0.
513 43 CONTINUE
514 IUTOTC=0
515 IUTOTE=0
516
517 IF ( NPARAM .GT. 0 ) THEN
518 DO 3 N=1,NPARAM
519 CALL UTLOW6(PARCHA(N))
520 IF ( DEBUG ) WRITE(MDEBUG,*) PARCHA(N),PARVAL(N)
521 IF (PARCHA(N).EQ.'AMPRIF')THEN
522 AMPRIF=PARVAL(N)
523 ELSEIF(PARCHA(N).EQ.'AMSIAC')THEN
524 AMSIAC=PARVAL(N)
525 ELSEIF(PARCHA(N).EQ.'AMUSEG')THEN
526 AMUSEG=PARVAL(N)
527 ELSEIF(PARCHA(N).EQ.'ANGMUE')THEN
528 ANGMUE=PARVAL(N)
529 ELSEIF(PARCHA(N).EQ.'BAG4RT')THEN
530 BAG4RT=PARVAL(N)
531 ELSEIF(PARCHA(N).EQ.'BMAXIM')THEN
532 BMAXIM=PARVAL(N)
533 ELSEIF(PARCHA(N).EQ.'BMINIM')THEN
534 BMINIM=PARVAL(N)
535 ELSEIF(PARCHA(N).EQ.'CORE ')THEN
536 CORE =PARVAL(N)
537 ELSEIF(PARCHA(N).EQ.'CORLEN')THEN
538 CORLEN=PARVAL(N)
539 ELSEIF(PARCHA(N).EQ.'CUTMSQ')THEN
540 CUTMSQ=PARVAL(N)
541 ELSEIF(PARCHA(N).EQ.'CUTMSS')THEN
542 CUTMSS=PARVAL(N)
543 ELSEIF(PARCHA(N).EQ.'DELEPS')THEN
544 DELEPS=PARVAL(N)
545 ELSEIF(PARCHA(N).EQ.'DELMSS')THEN
546 DELMSS=PARVAL(N)
547 ELSEIF(PARCHA(N).EQ.'DELREM')THEN
548 DELREM=PARVAL(N)
549 ELSEIF(PARCHA(N).EQ.'DELVOL')THEN
550 DELVOL=PARVAL(N)
551 ELSEIF(PARCHA(N).EQ.'ELEPTI')THEN
552 ELEPTI=PARVAL(N)
553 ELSEIF(PARCHA(N).EQ.'ELEPTO')THEN
554 ELEPTO=PARVAL(N)
555 ELSEIF(PARCHA(N).EQ.'EPSCRI')THEN
556 EPSCRI=PARVAL(N)
557 ELSEIF(PARCHA(N).EQ.'FCTRMX')THEN
558 FCTRMX=PARVAL(N)
559 ELSEIF(PARCHA(N).EQ.'GAUMX ')THEN
560 GAUMX =PARVAL(N)
561 ELSEIF(PARCHA(N).EQ.'GRICEL')THEN
562 GRICEL=PARVAL(N)
563 ELSEIF(PARCHA(N).EQ.'GRIDEL')THEN
564 GRIDEL=PARVAL(N)
565 ELSEIF(PARCHA(N).EQ.'GRIGAM')THEN
566 GRIGAM=PARVAL(N)
567 ELSEIF(PARCHA(N).EQ.'GRIRSQ')THEN
568 GRIRSQ=PARVAL(N)
569 ELSEIF(PARCHA(N).EQ.'GRISLO')THEN
570 GRISLO=PARVAL(N)
571 ELSEIF(PARCHA(N).EQ.'IAQU ')THEN
572 IAQU =PARVAL(N)
573 ELSEIF(PARCHA(N).EQ.'ICLHIS')THEN
574 ICLHIS=PARVAL(N)
575 ELSEIF(PARCHA(N).EQ.'IDPM ')THEN
576 IDPM =PARVAL(N)
577 ELSEIF(PARCHA(N).EQ.'IENTRO')THEN
578 IENTRO=NINT(PARVAL(N))
579 ELSEIF(PARCHA(N).EQ.'IFRADE')THEN
580 IFRADE=NINT(PARVAL(N))
581 ELSEIF(PARCHA(N).EQ.'IJPHIS')THEN
582 IJPHIS=PARVAL(N)
583 ELSEIF(PARCHA(N).EQ.'IMIHIS')THEN
584 IMIHIS=PARVAL(N)
585 ELSEIF(PARCHA(N).EQ.'IOJINT')THEN
586 IOJINT=PARVAL(N)
587 ELSEIF(PARCHA(N).EQ.'IOPBRK')THEN
588 IOPBRK=PARVAL(N)
589 ELSEIF(PARCHA(N).EQ.'IOPENT')THEN
590 IOPENT=PARVAL(N)
591 IOPENT = MOD(IOPENT,10)
592 ELSEIF(PARCHA(N).EQ.'IOPENU')THEN
593 IOPENU=PARVAL(N)
594 ELSEIF(PARCHA(N).EQ.'IOPTF ')THEN
595 IOPTF =PARVAL(N)
596 ELSEIF(PARCHA(N).EQ.'IOPTQ ')THEN
597 IOPTQ =PARVAL(N)
598 ELSEIF(PARCHA(N).EQ.'IPAGI ')THEN
599 IPAGI =PARVAL(N)
600 ELSEIF(PARCHA(N).EQ.'IRESCL')THEN
601 IRESCL=PARVAL(N)
602 ELSEIF(PARCHA(N).EQ.'ISH ')THEN
603 ISH =PARVAL(N)
604 ELSEIF(PARCHA(N).EQ.'ISHEVT')THEN
605 ISHEVT=PARVAL(N)
606 ELSEIF(PARCHA(N).EQ.'ISHSUB')THEN
607 ISHSUB=PARVAL(N)
608 ELSEIF(PARCHA(N).EQ.'ISPALL')THEN
609 ISPALL=PARVAL(N)
610 ELSEIF(PARCHA(N).EQ.'ISPHIS')THEN
611 ISPHIS=PARVAL(N)
612 ELSEIF(PARCHA(N).EQ.'ISTMAX')THEN
613 ISTMAX=PARVAL(N)
614 ELSEIF(PARCHA(N).EQ.'ISUP ')THEN
615 ISUP =PARVAL(N)
616 ELSEIF(PARCHA(N).EQ.'IVERSN')THEN
617 IVERSN=PARVAL(N)
618 ELSEIF(PARCHA(N).EQ.'IVI ')THEN
619 IVI =PARVAL(N)
620 ELSEIF(PARCHA(N).EQ.'IWCENT')THEN
621 IWCENT=NINT(PARVAL(N))
622 ELSEIF(PARCHA(N).EQ.'IWZZZZ')THEN
623 IWZZZZ=PARVAL(N)
624 ELSEIF(PARCHA(N).EQ.'JPSI ')THEN
625 JPSI =PARVAL(N)
626 ELSEIF(PARCHA(N).EQ.'JPSIFI')THEN
627 JPSIFI=PARVAL(N)
628 ELSEIF(PARCHA(N).EQ.'KENTRO')THEN
629 KENTRO=PARVAL(N)
630 ELSEIF(PARCHA(N).EQ.'KO1KO2')THEN
631 KO1KO2=PARVAL(N)
632 ELSEIF(PARCHA(N).EQ.'KUTDIQ')THEN
633 KUTDIQ=PARVAL(N)
634 ELSEIF(PARCHA(N).EQ.'LABSYS')THEN
635 LABSYS=PARVAL(N)
636 ELSEIF(PARCHA(N).EQ.'MAXRES')THEN
637 MAXRES=PARVAL(N)
638 ELSEIF(PARCHA(N).EQ.'NCLEAN')THEN
639 NCLEAN=PARVAL(N)
640 ELSEIF(PARCHA(N).EQ.'NCOLMX')THEN
641 NCOLMX=PARVAL(N)
642 ELSEIF(PARCHA(N).EQ.'NDECAW')THEN
643 NDECAW=PARVAL(N)
644 ELSEIF(PARCHA(N).EQ.'NDECAX')THEN
645 NDECAX=NINT(PARVAL(N))
646 ELSEIF(PARCHA(N).EQ.'NDECAY')THEN
647 NDECAY=NINT(PARVAL(N))
648 ELSEIF(PARCHA(N).EQ.'NEQMN ')THEN
649 NEQMN =PARVAL(N)
650 ELSEIF(PARCHA(N).EQ.'NEQMX ')THEN
651 NEQMX =PARVAL(N)
652 ELSEIF(PARCHA(N).EQ.'NSTTAU')THEN
653 NSTTAU=PARVAL(N)
654 ELSEIF(PARCHA(N).EQ.'NTRYMX')THEN
655 NTRYMX=PARVAL(N)
656 ELSEIF(PARCHA(N).EQ.'NUMTAU')THEN
657 NUMTAU=PARVAL(N)
658 ELSEIF(PARCHA(N).EQ.'OVERLP')THEN
659 OVERLP=PARVAL(N)
660 ELSEIF(PARCHA(N).EQ.'PAREA ')THEN
661 PAREA =PARVAL(N)
662 ELSEIF(PARCHA(N).EQ.'PDIQUA')THEN
663 PDIQUA=PARVAL(N)
664 ELSEIF(PARCHA(N).EQ.'PISPN ')THEN
665 PISPN =PARVAL(N)
666 ELSEIF(PARCHA(N).EQ.'PROSEA')THEN
667 PROSEA=PARVAL(N)
668 ELSEIF(PARCHA(N).EQ.'PSPINH')THEN
669 PSPINH=PARVAL(N)
670 ELSEIF(PARCHA(N).EQ.'PSPINL')THEN
671 PSPINL=PARVAL(N)
672 ELSEIF(PARCHA(N).EQ.'PTF ')THEN
673 PTF =PARVAL(N)
674 ELSEIF(PARCHA(N).EQ.'PTH ')THEN
675 PTH =PARVAL(N)
676 ELSEIF(PARCHA(N).EQ.'PHARD ')THEN
677 PHARD =PARVAL(N)
678 ELSEIF(PARCHA(N).EQ.'PTMX ')THEN
679 PTMX =PARVAL(N)
680 ELSEIF(PARCHA(N).EQ.'PTQ1 ')THEN
681 PTQ1 =PARVAL(N)
682 ELSEIF(PARCHA(N).EQ.'PTQ2 ')THEN
683 PTQ2 =PARVAL(N)
684 ELSEIF(PARCHA(N).EQ.'PTQ3 ')THEN
685 PTQ3 =PARVAL(N)
686 ELSEIF(PARCHA(N).EQ.'PUD ')THEN
687 PUD =PARVAL(N)
688 ELSEIF(PARCHA(N).EQ.'PVALEN')THEN
689 PVALEN=PARVAL(N)
690 ELSEIF(PARCHA(N).EQ.'QMUST ')THEN
691 CALL UTSTOP('VENINI: *** QMUST NOT USED ANYMORE! *** ')
692 ELSEIF(PARCHA(N).EQ.'QMUST1')THEN
693 QMUST1=PARVAL(N)
694 ELSEIF(PARCHA(N).EQ.'QMUST2')THEN
695 QMUST2=PARVAL(N)
696 ELSEIF(PARCHA(N).EQ.'QMUST3')THEN
697 QMUST3=PARVAL(N)
698 ELSEIF(PARCHA(N).EQ.'RADIAC')THEN
699 RADIAC=PARVAL(N)
700 ELSEIF(PARCHA(N).EQ.'RADIAS')THEN
701 RADIAS=PARVAL(N)
702 ELSEIF(PARCHA(N).EQ.'RHOPHI')THEN
703 RHOPHI=PARVAL(N)
704 ELSEIF(PARCHA(N).EQ.'RSTRAS')THEN
705 RSTRAS=PARVAL(N)
706 ELSEIF(PARCHA(N).EQ.'SEEDI ')THEN
707 SEEDI =PARVAL(N)
708 ELSEIF(PARCHA(N).EQ.'SIGJ ')THEN
709 SIGJ =PARVAL(N)
710 ELSEIF(PARCHA(N).EQ.'SIGPPI')THEN
711 SIGPPI=PARVAL(N)
712 ELSEIF(PARCHA(N).EQ.'SMAS ')THEN
713 SMAS =PARVAL(N)
714 ELSEIF(PARCHA(N).EQ.'SSMAS ')THEN
715 SSMAS =PARVAL(N)
716 ELSEIF(PARCHA(N).EQ.'TAUMAX')THEN
717 TAUMAX=PARVAL(N)
718 ELSEIF(PARCHA(N).EQ.'TAUMIN')THEN
719 TAUMIN=PARVAL(N)
720 ELSEIF(PARCHA(N).EQ.'TAUMX ')THEN
721 TAUMX =PARVAL(N)
722 ELSEIF(PARCHA(N).EQ.'TAUNLL')THEN
723 TAUNLL=PARVAL(N)
724 ELSEIF(PARCHA(N).EQ.'TAUREA')THEN
725 TAUREA=PARVAL(N)
726 ELSEIF(PARCHA(N).EQ.'TENSN ')THEN
727 TENSN =PARVAL(N)
728 ELSEIF(PARCHA(N).EQ.'THEMAS')THEN
729 THEMAS=PARVAL(N)
730 ELSEIF(PARCHA(N).EQ.'UENTRO')THEN
731 UENTRO=PARVAL(N)
732 ELSEIF(PARCHA(N).EQ.'USMAS ')THEN
733 USMAS =PARVAL(N)
734 ELSEIF(PARCHA(N).EQ.'UUMAS ')THEN
735 UUMAS =PARVAL(N)
736 ELSEIF(PARCHA(N).EQ.'WPROJ ')THEN
737 WPROJ =PARVAL(N)
738 ELSEIF(PARCHA(N).EQ.'WTARG ')THEN
739 WTARG =PARVAL(N)
740 ELSEIF(PARCHA(N).EQ.'WTMINI')THEN
741 WTMINI=PARVAL(N)
742 ELSEIF(PARCHA(N).EQ.'WTSTEP')THEN
743 WTSTEP=PARVAL(N)
744 ELSEIF(PARCHA(N).EQ.'YMXIMI')THEN
745 YMXIMI=PARVAL(N)
746 ENDIF
747 3 CONTINUE
748 ENDIF
749
750 IF ( ISPHIS .EQ. 1 ) LABSYS = 0
751 IF ( IDPM .EQ. 1 ) THEN
752 IAQU = 0
753 NEQMN = 2
754 NEQMX = 3
755 ENDIF
756 IF ( IOPENU .EQ. 2 ) THEN
757 CALL SMASSI(THEMAS)
758 IF ( ISH .EQ. 19 ) THEN
759 CALL SMASSP
760 CALL UTSTOP(' VENLNK: ')
761 ENDIF
762 ENDIF
763
764 IF ( IOJINT .EQ. 2 ) THEN
765 IF ( EPSCRI .LT. 0. ) THEN
766 RADIAC = 0.
767 RADIAS = 0.
768 ELSEIF ( EPSCRI .GT. 0. ) THEN
769 VOLBAR = PROM/EPSBAR*PI*0.25
770CDH RADIAC = (VOLBAR*0.5/PI)**0.3333333
771 VOLMES = 0.455/EPSCRI*PI*0.25
772CDH RADIAS = (VOLMES*0.5/PI)**0.3333333
773 ELSE
774 CALL UTSTOP('EPSCRI MUST NOT BE 0. ')
775 ENDIF
776 ENDIF
777
778 CALL JDECIN(.FALSE.)
779C INITIALIZE ALL PT DISTRIBUTIONS
780 CX = PTMX
781 QUAMA = 0.
782 IF ( IOPTF .EQ. 1 ) THEN
783 ROOT = SQRT(PTMX**2+QUAMA**2)
784 AUXIL = 2./PTF
785 BPTFU = +0.25*PTF**2*EXP(-AUXIL*QUAMA)*(AUXIL*QUAMA+1.)
786 FPTFU = -0.25*PTF**2*EXP(-AUXIL*ROOT)*(AUXIL*ROOT+1.)+BPTFU
787 CALL UTQUAF(SPTF,NPTF,XPTF,QPTFU,0.,.33*CX,.66*CX,CX)
788C DO 199 N=1,NPTF
789C WRITE(IFCH,*)'N,X,Q=',N,XPTF(N),QPTFU(N)
790C199 CONTINUE
791 ELSE
792 AUXIL = 0.25*PI/PTF**2
793 BPTFU = +EXP(-AUXIL* QUAMA**2)*0.5/AUXIL
794 FPTFU = -EXP(-AUXIL*(QUAMA**2+PTMX**2))*0.5/AUXIL+BPTFU
795 ENDIF
796
797 QUAMA = SMAS
798 IF ( QUAMA .NE. 0. ) THEN
799 IF ( IOPTF .EQ. 1 ) THEN
800 ROOT = SQRT(PTMX**2+SMAS**2)
801 AUXIL = 2./PTF
802 BPTFS = +0.25*PTF**2*EXP(-AUXIL*SMAS)*(AUXIL*SMAS+1.)
803 FPTFS = -0.25*PTF**2*EXP(-AUXIL*ROOT)*(AUXIL*ROOT+1.)+BPTFS
804 CALL UTQUAF(SPTF,NPTF,XPTF,QPTFS,0.,.33*CX,.66*CX,CX)
805 ELSE
806 AUXIL = 0.25*PI/PTF**2
807 BPTFS = +EXP(-AUXIL* SMAS**2)*0.5/AUXIL
808 FPTFS = -EXP(-AUXIL*(SMAS**2+PTMX**2))*0.5/AUXIL+BPTFS
809 ENDIF
810 ELSE
811 DO 201 N = 1,NPTF
812 QPTFS(N) = QPTFU(N)
813 201 CONTINUE
814 FPTFS = FPTFU
815 ENDIF
816
817 QUAMA = UUMAS
818 IF ( QUAMA .NE. 0. ) THEN
819 IF ( IOPTF .EQ. 1 ) THEN
820 ROOT = SQRT(PTMX**2+UUMAS**2)
821 AUXIL = 2./PTF
822 BPTFUU = +0.25*PTF**2*EXP(-AUXIL*UUMAS)*(AUXIL*UUMAS+1.)
823 FPTFUU = -0.25*PTF**2*EXP(-AUXIL*ROOT)*(AUXIL*ROOT+1.)+BPTFUU
824 CALL UTQUAF(SPTF,NPTF,XPTF,QPTFUU,0.,.33*CX,.66*CX,CX)
825 ELSE
826 AUXIL = 0.25*PI/PTF**2
827 BPTFUU = EXP(-AUXIL* UUMAS**2)*0.5/AUXIL
828 FPTFUU = -EXP(-AUXIL*(UUMAS**2+PTMX**2))*0.5/AUXIL+BPTFUU
829 ENDIF
830 ELSE
831 DO 202 N = 1,NPTF
832 QPTFUU(N) = QPTFU(N)
833 202 CONTINUE
834 FPTFUU = FPTFU
835 ENDIF
836
837 QUAMA = USMAS
838 IF ( QUAMA .NE. 0. ) THEN
839 IF ( IOPTF .EQ. 1 ) THEN
840 ROOT = SQRT(PTMX**2+USMAS**2)
841 AUXIL = 2./PTF
842 BPTFUS = 0.25*PTF**2*EXP(-AUXIL*USMAS)*(AUXIL*USMAS+1.)
843 FPTFUS = -0.25*PTF**2*EXP(-AUXIL*ROOT)*(AUXIL*ROOT+1.)+BPTFUS
844 CALL UTQUAF(SPTF,NPTF,XPTF,QPTFUS,0.,.33*CX,.66*CX,CX)
845 ELSE
846 AUXIL = 0.25*PI/PTF**2
847 BPTFUS = EXP(-AUXIL* USMAS**2)*0.5/AUXIL
848 FPTFUS = -EXP(-AUXIL*(USMAS**2+PTMX**2))*0.5/AUXIL+BPTFUS
849 ENDIF
850 ELSE
851 DO 203 N = 1,NPTF
852 QPTFUS(N) = QPTFU(N)
853 203 CONTINUE
854 FPTFUS = FPTFU
855 ENDIF
856
857 QUAMA = SSMAS
858 IF ( QUAMA .NE. 0. ) THEN
859 IF ( IOPTF .EQ. 1 ) THEN
860 ROOT = SQRT(PTMX**2+SSMAS**2)
861 AUXIL = 2./PTF
862 BPTFSS = +0.25*PTF**2*EXP(-AUXIL*SSMAS)*(AUXIL*SSMAS+1.)
863 FPTFSS = -0.25*PTF**2*EXP(-AUXIL*ROOT)*(AUXIL*ROOT+1.)+BPTFSS
864 CALL UTQUAF(SPTF,NPTF,XPTF,QPTFSS,0.,.33*CX,.66*CX,CX)
865 ELSE
866 AUXIL = 0.25*PI/PTF**2
867 BPTFSS = EXP(-AUXIL* SSMAS**2)*0.5/AUXIL
868 FPTFSS = -EXP(-AUXIL*(SSMAS**2+PTMX**2))*0.5/AUXIL+BPTFSS
869 ENDIF
870 ELSE
871 DO 204 N = 1,NPTF
872 QPTFSS(N) = QPTFU(N)
873 204 CONTINUE
874 FPTFSS = FPTFU
875 ENDIF
876
877C INITIALIZE FUNCTIONS FOR JPSI GENERATION
878 IF ( JPSI .EQ. 1 ) THEN
879 CX = GAUMX
880 CALL UTQUAF(SGAU,NGAU,XGAU,QGAU,0.,.33*CX,.66*CX,CX)
881 CX = PTMX
882 CALL UTQUAF(SPTJ,NPTJ,XPTJ,QPTJ,0.,.33*CX,.66*CX,CX)
883 ENDIF
884
885C INITIALIZE DENSITY DISTRIBUTION INTEGRALS FOR NITROGEN, OXYGEN, ARGON
886 MASSNR = 14.
887 R0 = 1.19*MASSNR**(.3333333) -1.61*MASSNR**(-.3333333)
888 CX = R0+FCTRMX*0.54
889 RMTARG(1) = CX
890 CALL UTQUAF(SDENSI,NDET,XDET14,QDET14,0.,.33*CX,.66*CX,CX)
891
892 MASSNR = 16.
893 R0 = 1.19*MASSNR**(.3333333) -1.61*MASSNR**(-.3333333)
894 CX = R0+FCTRMX*0.54
895 RMTARG(2) = CX
896 CALL UTQUAF(SDENSI,NDET,XDET16,QDET16,0.,.33*CX,.66*CX,CX)
897
898 MASSNR = 40.
899 R0 = 1.19*MASSNR**(.3333333) -1.61*MASSNR**(-.3333333)
900 CX = R0+FCTRMX*0.54
901 RMTARG(3) = CX
902 CALL UTQUAF(SDENSI,NDET,XDET40,QDET40,0.,.33*CX,.66*CX,CX)
903
904C QDET99 AND XDET99 ARE NOT INITIALIZED
905 MTAR99 = 0
906
907 OPEN(UNIT=14,FILE='VENUSDAT',STATUS='OLD')
908 READ(14,*)(IDUMMY, XVA(I), QVAH(I), QVAPI(I), I=1,2049)
909 CLOSE(UNIT=14)
910
911 WRITE(IFMT,105) FLOAT(IVERSN)/1000.
912 105 FORMAT(
913 * ' !-----------------------------------------------------!'
914 */' ! V(ERY) E(NERGETIC) NU(CLEAR) S(CATTERING) !'
915 */' ! VENUS',F6.3,5X,'- K. WERNER !'
916 */' ! SUBROUTINE TURBOVERSION D. HECK !'
917 */' !-----------------------------------------------------!')
918 RETURN
919 END
Note: See TracBrowser for help on using the repository browser.