source: trunk/MagicSoft/Simulation/Corsika/Mmcs/datac.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: 34.2 KB
Line 
1 SUBROUTINE DATAC
2
3C-----------------------------------------------------------------------
4C DATA C(ARDS)
5C
6C READS DATA CARDS FROM UNIT 5 TO STEER RUN.
7C READING IS FREE FORMAT WITH BLANK AS SEPARATOR.
8C EACH KEYWORD STARTS ON A NEW LINE LEFTSHIFTED.
9C THIS SUBROUTINE IS CALLED FROM START
10C
11C AUTHOR : J. KNAPP IK1 FZK KARLSRUHE
12C-----------------------------------------------------------------------
13
14c IMPLICIT NONE
15
16c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
17c All this lines are under test
18c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
19 parameter (xct=1)
20 parameter (yct=2)
21 parameter (zct=3)
22 parameter (ctthet=4)
23 parameter (ctphi=5)
24 parameter (ctdiam=6)
25 parameter (ctfoc=7)
26c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
27
28*KEEP,DPMFLG.
29 COMMON /DPMFLG/ NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
30 INTEGER NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
31*KEEP,ELABCT.
32 COMMON /ELABCT/ ELCUT
33 DOUBLE PRECISION ELCUT(4)
34*KEEP,ETHMAP.
35 COMMON /ETHMAP/ ECTMAP,ELEFT
36 DOUBLE PRECISION ECTMAP,ELEFT
37*KEEP,LONGI.
38 COMMON /LONGI/ APLONG,HLONG,PLONG,SPLONG,THSTEP,THSTPI,
39 * NSTEP,LLONGI,FLGFIT
40 DOUBLE PRECISION APLONG(0:1040,9),HLONG(0:1024),PLONG(0:1040,9),
41 * SPLONG(0:1040,9),THSTEP,THSTPI
42 INTEGER NSTEP
43 LOGICAL LLONGI,FLGFIT
44*KEEP,MAGANG.
45 COMMON /MAGANG/ ARRANG,ARRANR,COSANG,SINANG
46 DOUBLE PRECISION ARRANG,ARRANR,COSANG,SINANG
47*KEEP,MAGNET.
48 COMMON /MAGNET/ BX,BZ,BVAL,BNORMC,BNORM,COSB,SINB,BLIMIT
49 DOUBLE PRECISION BX,BZ,BVAL,BNORMC
50 REAL BNORM,COSB,SINB,BLIMIT
51*KEEP,MUMULT.
52 COMMON /MUMULT/ CHC,OMC,FMOLI
53 DOUBLE PRECISION CHC,OMC
54 LOGICAL FMOLI
55*KEEP,OBSPAR.
56 COMMON /OBSPAR/ OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
57 * THETPR,PHIPR,NOBSLV
58 DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
59 * THETAP,THETPR(2),PHIP,PHIPR(2)
60 INTEGER NOBSLV
61*KEEP,PARPAR.
62 COMMON /PARPAR/ CURPAR,SECPAR,PRMPAR,OUTPAR,C,
63 * E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
64 DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
65 * C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
66 INTEGER ITYPE,LEVL
67*KEEP,NKGI.
68 COMMON /NKGI/ SEL,SELLG,STH,ZEL,ZELLG,ZSL,DIST,
69 * DISX,DISY,DISXY,DISYX,DLAX,DLAY,DLAXY,DLAYX,
70 * OBSATI,RADNKG,RMOL,TLEV,TLEVCM,IALT
71 DOUBLE PRECISION SEL(10),SELLG(10),STH(10),ZEL(10),ZELLG(10),
72 * ZSL(10),DIST(10),
73 * DISX(-10:10),DISY(-10:10),
74 * DISXY(-10:10,2),DISYX(-10:10,2),
75 * DLAX (-10:10,2),DLAY (-10:10,2),
76 * DLAXY(-10:10,2),DLAYX(-10:10,2),
77 * OBSATI(2),RADNKG,RMOL(2),TLEV(10),TLEVCM(10)
78 INTEGER IALT(2)
79*KEEP,PRIMSP.
80 COMMON /PRIMSP/ PSLOPE,LLIMIT,ULIMIT,LL,UL,SLEX,ISPEC
81 DOUBLE PRECISION PSLOPE,LLIMIT,ULIMIT,LL,UL,SLEX
82 INTEGER ISPEC
83*KEEP,RANDPA.
84 COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR
85 DOUBLE PRECISION FAC,U1,U2
86 REAL RD(3000)
87 INTEGER ISEED(103,10),NSEQ
88 LOGICAL KNOR
89*KEEP,REJECT.
90 COMMON /REJECT/ AVNREJ,
91 * ALTMIN,ANEXP,THICKA,THICKD,CUTLN,EONCUT,
92 * FNPRIM
93 DOUBLE PRECISION AVNREJ(10)
94 REAL ALTMIN(10),ANEXP(10),THICKA(10),THICKD(10),
95 * CUTLN,EONCUT
96 LOGICAL FNPRIM
97*KEEP,RUNPAR.
98 COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
99 * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
100 * MONIOU,MDEBUG,NUCNUC,
101 * CETAPE,
102 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
103 * N1STTR,MDBASE,
104 * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
105 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
106 * ,GHEISH,GHESIG
107 COMMON /RUNPAC/ DSN,HOST,USER
108 DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
109 REAL STEPFC
110 INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
111 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
112 * N1STTR,MDBASE
113 INTEGER CETAPE
114 CHARACTER*79 DSN
115 CHARACTER*20 HOST,USER
116
117 LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
118 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
119 * ,GHEISH,GHESIG
120*KEEP,VENPAR.
121 COMMON /VENPAR/ PARVAL,NPARAM,PARCHA
122 REAL PARVAL(100)
123 INTEGER NPARAM
124 CHARACTER*6 PARCHA(100)
125*KEEP,VENUS.
126 COMMON /VENUS/ ISH0,IVERVN,MTAR99,FVENUS,FVENSG
127 INTEGER ISH0,IVERVN,MTAR99
128 LOGICAL FVENUS,FVENSG
129*KEEP,CEREN1.
130 COMMON /CEREN1/ CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD,
131 * CERSIZ,LCERFI
132 DOUBLE PRECISION CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD
133 REAL CERSIZ
134 LOGICAL LCERFI
135*KEEP,CEREN2.
136 COMMON /CEREN2/ PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
137 * DCERX,DCERY,ACERX,ACERY,
138 * XCMAX,YCMAX,EPSX,EPSY,
139 * DCERXI,DCERYI,FCERX,FCERY,
140 * XSCATT,YSCATT,CERXOS,CERYOS,
141 * NCERX,NCERY,ICERML
142 REAL PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
143 * DCERX,DCERY,ACERX,ACERY,
144 * XCMAX,YCMAX,EPSX,EPSY,
145 * DCERXI,DCERYI,FCERX,FCERY,
146 * XSCATT,YSCATT,CERXOS(20),CERYOS(20)
147 INTEGER NCERX,NCERY,ICERML
148c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
149c All this lines are under test
150c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
151*keep,certel.
152 common /certel/ cormxd,cord,coralp,ctpars,omega,
153 + photn,photnp,phpt,pht,vphot,
154 + vchi,veta,vzeta,vchim,vetam,vzetam,
155 + lambda,mu,nu,nctels,ncph
156 double precision cormxd,cord,coralp,ctpars(20,7),omega(20,3,3),
157 + photn(3),photnp(3),phpt(3),pht,vphot(3),
158 + vchi(3),veta(3),vzeta(3),vchim,vetam,vzetam,
159 + lambda,mu,nu
160 integer nctels,ncph(5)
161 double precision xg,yg,zg,xgp,ygp,zgp,up,vp,wp,xpcut,ypcut,zpcut
162 equivalence (photn(1) ,xg) ,(photn(2) ,yg) ,(photn(3) ,zg) ,
163 + (photnp(1),xgp) ,(photnp(2),ygp) ,(photnp(3),zgp),
164 + (phpt(1) ,xpcut),(phpt(2) ,ypcut),(phpt(3) ,zpcut),
165 + (vphot(1) ,up) ,(vphot(2) ,vp) ,(vphot(3) ,wp)
166 character *72 ctfile
167
168 character *6 keyw
169c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
170C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
171c Angles for the "spinning" of a particle around the
172c main axis of the CT
173 common /spinang/ spinxi
174 double precision spinxi
175C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
176*KEND.
177
178 DOUBLE PRECISION R1,R2
179 INTEGER I,IE,IOBSLV,IS,ISEQ,MMM,MONNEW,NNTYP
180 INTEGER IPARAM
181 CHARACTER LINE*80, CFMTF*7, CFMTI*5, CFMTL*4
182 DATA CFMTF/'(F10.0)'/, CFMTI/'(I11)'/, CFMTL/'(L1)'/
183C-----------------------------------------------------------------------
184
185C WRITE TITEL
186 WRITE(MONIOU,999)
187 999 FORMAT(' ',10('='),' USERS RUN DIRECTIVES FOR THIS SIMULATION ',
188 * 27('=')/)
189
190C DEFAULT VALUES FOR ALL RUN PARAMETERS
191 ISEQ = 0
192 NSEQ = 2
193 ISEED(1,1) = 1
194 ISEED(2,1) = 0
195 ISEED(3,1) = 0
196 ISEED(1,2) = 2
197 ISEED(2,2) = 0
198 ISEED(3,2) = 0
199 ISEED(1,3) = 3
200 ISEED(2,3) = 0
201 ISEED(3,3) = 0
202 NRRUN = 1
203 SHOWNO = 0
204 LLIMIT = 1.D4
205 ULIMIT = 1.D4
206 PSLOPE = 0.D0
207 PRMPAR(1) = 14.D0
208 THETPR(1) = 0.D0
209 THETPR(2) = 0.D0
210 PHIPR(1) = 0.D0
211 PHIPR(2) = 0.D0
212 NSHOW = 10
213 IOBSLV = 0
214 NOBSLV = 1
215 OBSLEV(1) = 110.D2
216 ELCUT(1) = 0.3D0
217 ELCUT(2) = 0.3D0
218 ELCUT(3) = 0.003D0
219 ELCUT(4) = 0.003D0
220 ECTMAP = 1.D4
221 NFLAIN = 0
222 NFLDIF = 0
223 NFLPI0 = 0
224 NFLPIF = 0
225 NFLCHE = 0
226 NFRAGM = 0
227 FNKG = .TRUE.
228 FMOLI = .TRUE.
229 FMUADD = .FALSE.
230 FEGS = .FALSE.
231 STEPFC = 10.
232 MAXPRT = 10
233 BX = 20.D0
234 BZ = 42.8D0
235 ARRANG = 0.D0
236 LLONGI = .FALSE.
237 FLGFIT = .FALSE.
238 THSTEP = 20.D0
239 RADNKG = 200.D2
240C BORDER BETWEEN LOW AND HIGH ENERGY INTERACTION MODELS
241C SET BY DEFAULT TO ELAB = 80 GEV
242 HILOELB = 80.D0
243 GHEISH = .TRUE.
244 FDBASE = .TRUE.
245 DEBUG = .FALSE.
246 DEBDEL = .FALSE.
247 NDEBDL = 100000000
248 THICK0 = 0.D0
249 FIX1I = .FALSE.
250 FIXHEI = 0.D0
251 DSN =
252 *'ANYNAMEUPTO64CHARACTERS '
253 HOST = ' '
254 USER = ' '
255 WAVLGL = 300.D0
256 WAVLGU = 450.D0
257 CERSIZ = 0.
258 NCERX = 27
259 NCERY = 27
260 DCERX = 1500.
261 DCERY = 1500.
262 ACERX = 100.
263 ACERY = 100.
264 LCERFI = .TRUE.
265 ICERML = 1
266 XSCATT = 0.
267 YSCATT = 0.
268 DO 554 I = 1,20
269 CERXOS(I) = 0.
270 CERYOS(I) = 0.
271 554 CONTINUE
272 FVENUS =.TRUE.
273 ISH0 = 91
274 IPARAM = 0
275 NPARAM = 0
276 DO 555 I = 1,100
277 PARVAL(I) = 0.
278 555 CONTINUE
279 FVENSG =.FALSE.
280
281C-----------------------------------------------------------------------
282C OPEN DATASET FOR COMMANDS
283 IF ( MONIIN .NE. 5 ) THEN
284 OPEN(UNIT=MONIIN,FILE='INPUTS',STATUS='OLD',FORM='FORMATTED')
285 WRITE(MONIOU,*) 'DATA CARDS FOR RUN STEERING ARE ',
286 * 'EXPECTED FROM UNIT',MONIIN
287 ELSE
288 WRITE(MONIOU,*) 'DATA CARDS FOR RUN STEERING ARE ',
289 * 'EXPECTED FROM STANDARD INPUT'
290 ENDIF
291
292C-----------------------------------------------------------------------
293 1 CONTINUE
294
295C ERASE 'LINE' BY FILLING WITH BLANKS
296 DO 2 I=1,80
297 LINE(I:I) = ' '
298 2 CONTINUE
299
300C GET A NEW INPUT LINE AND PRINT IT
301 READ(MONIIN,500,END=1000) LINE
302 500 FORMAT(A80)
303 IF (DEBUG) THEN
304 WRITE(MDEBUG,501) LINE
305 501 FORMAT(' DATAC : ',A80)
306 ELSE
307 WRITE(MONIOU,502) LINE
308 502 FORMAT(' ',A80)
309 ENDIF
310
311C CONVERT LOWER CASE CHARACTERS TO UPPER CASE
312 DO 3 I=1,5
313 CALL LOWUP(LINE(I:I))
314 3 CONTINUE
315 IF ( LINE(1:4).NE.'HOST' .AND. LINE(1:4).NE.'USER' ) THEN
316 CALL LOWUP(LINE(6:6))
317 IF ( LINE(1:6).NE.'DIRECT' .AND. LINE(1:6).NE.'HISTDS' ) THEN
318 DO 4 I=7,80
319 CALL LOWUP(LINE(I:I))
320 4 CONTINUE
321 ENDIF
322 ENDIF
323
324C-----------------------------------------------------------------------
325C INTERPRET KEYWORD AND READ PARAMETERS
326
327C DUMMY LINE (MAY BE USED FOR COMMENTS) NO ACTION
328 IF ( LINE(1:6) .EQ. ' ' ) THEN
329 ELSEIF ( LINE(1:1) .EQ. '*' ) THEN
330 ELSEIF ( LINE(1:2) .EQ. 'C ' ) THEN
331
332C GET ANGLE (DEGREES) BETWEEN ARRAY X-DIRCTION AND MAGNETIC NORD
333 ELSEIF ( LINE(1:6) .EQ. 'ARRANG' ) THEN
334 IS = 6
335 11 CONTINUE
336 IS = IS + 1
337 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 11
338 IE = INDEX(LINE(IS:),' ') + IS - 2
339 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
340 READ(LINE(IS:IE),CFMTF) ARRANG
341
342C GET CERENKOV ARRAY SPECIFICATIONS
343 ELSEIF ( LINE(1:6) .EQ. 'CERARY' ) THEN
344 IS = 6
345 21 CONTINUE
346 IS = IS + 1
347 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 21
348 IE = INDEX(LINE(IS:),' ') + IS - 2
349 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
350 READ(LINE(IS:IE),CFMTI) NCERX
351 IS = IE
352 22 CONTINUE
353 IS = IS + 1
354 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 22
355 IE = INDEX(LINE(IS:),' ') + IS - 2
356 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
357 READ(LINE(IS:IE),CFMTI) NCERY
358 IS = IE
359 23 CONTINUE
360 IS = IS + 1
361 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 23
362 IE = INDEX(LINE(IS:),' ') + IS - 2
363 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
364 READ(LINE(IS:IE),CFMTF) DCERX
365 IS = IE
366 24 CONTINUE
367 IS = IS + 1
368 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 24
369 IE = INDEX(LINE(IS:),' ') + IS - 2
370 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
371 READ(LINE(IS:IE),CFMTF) DCERY
372 IS = IE
373 25 CONTINUE
374 IS = IS + 1
375 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 25
376 IE = INDEX(LINE(IS:),' ') + IS - 2
377 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
378 READ(LINE(IS:IE),CFMTF) ACERX
379 IS = IE
380 26 CONTINUE
381 IS = IS + 1
382 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 26
383 IE = INDEX(LINE(IS:),' ') + IS - 2
384 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
385 READ(LINE(IS:IE),CFMTF) ACERY
386
387C GET CERENKOV OUTPUT FLAG
388 ELSEIF ( LINE(1:6) .EQ. 'CERFIL' ) THEN
389 IS = 6
390 31 CONTINUE
391 IS = IS + 1
392 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 31
393 IE = INDEX(LINE(IS:),' ') + IS - 2
394 WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
395 READ(LINE(IS:IE),CFMTL) LCERFI
396
397C GET MAXIMUM BUNCH SIZE FOR CERENKOV PHOTONS
398 ELSEIF ( LINE(1:6) .EQ. 'CERSIZ' ) THEN
399 IS = 6
400 36 CONTINUE
401 IS = IS + 1
402 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 36
403 IE = INDEX(LINE(IS:),' ') + IS - 2
404 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
405 READ(LINE(IS:IE),CFMTF) CERSIZ
406
407c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
408C get maximum "xi" angle, respecto to the CT direction
409 ELSEIF ( LINE(1:3) .EQ. 'XIP' ) THEN
410 IS = 3
411 41 CONTINUE
412 IS = IS + 1
413 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 41
414 IE = INDEX(LINE(IS:),' ') + IS - 2
415 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
416 READ(LINE(IS:IE),CFMTF) spinxi
417
418C GET CERENKOV EVENT SCATTERING INFORMATION
419 ELSEIF ( LINE(1:5) .EQ. 'CSCAT' ) THEN
420 IS = 5
421 43 CONTINUE
422 IS = IS + 1
423 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 43
424 IE = INDEX(LINE(IS:),' ') + IS - 2
425 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
426 READ(LINE(IS:IE),CFMTI) ICERML
427 IS = IE
428 44 CONTINUE
429 IS = IS + 1
430 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 44
431 IE = INDEX(LINE(IS:),' ') + IS - 2
432 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
433 READ(LINE(IS:IE),CFMTF) XSCATT
434 IS = IE
435 45 CONTINUE
436 IS = IS + 1
437 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 45
438 IE = INDEX(LINE(IS:),' ') + IS - 2
439 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
440 READ(LINE(IS:IE),CFMTF) YSCATT
441
442C GET CERENKOV WAVELENGTH BAND
443 ELSEIF ( LINE(1:6) .EQ. 'CWAVLG' ) THEN
444 IS = 6
445 46 CONTINUE
446 IS = IS + 1
447 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 46
448 IE = INDEX(LINE(IS:),' ') + IS - 2
449 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
450 READ(LINE(IS:IE),CFMTF) R1
451 IS = IE
452 47 CONTINUE
453 IS = IS + 1
454 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 47
455 IE = INDEX(LINE(IS:),' ') + IS - 2
456 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
457 READ(LINE(IS:IE),CFMTF) R2
458 WAVLGL = MIN( R1, R2 )
459 WAVLGU = MAX( R1, R2 )
460
461C GET DATABASE FLAG
462 ELSEIF ( LINE(1:6) .EQ. 'DATBAS' ) THEN
463 IS = 6
464 50 CONTINUE
465 IS = IS + 1
466 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 50
467 IE = INDEX(LINE(IS:),' ') + IS - 2
468 WRITE(CFMTL(3:3),'(I2)') IE - IS + 1
469 READ(LINE(IS:IE),CFMTL) FDBASE
470
471C GET DEBUG FLAG AND DELAYED DEBUG PARAMETERS
472 ELSEIF ( LINE(1:5) .EQ. 'DEBUG' ) THEN
473 IS = 5
474 51 CONTINUE
475 IS = IS + 1
476 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 51
477 IE = INDEX(LINE(IS:),' ') + IS - 2
478 WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
479 READ(LINE(IS:IE),CFMTL) DEBUG
480 IS = IE
481 52 CONTINUE
482 IS = IS + 1
483 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 52
484 IE = INDEX(LINE(IS:),' ') + IS - 2
485 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
486 READ(LINE(IS:IE),CFMTI) MMM
487 IS = IE
488 53 CONTINUE
489 IS = IS + 1
490 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 53
491 IE = INDEX(LINE(IS:),' ') + IS - 2
492 WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
493 READ(LINE(IS:IE),CFMTL) DEBDEL
494 IS = IE
495 54 CONTINUE
496 IS = IS + 1
497 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 54
498 IE = INDEX(LINE(IS:),' ') + IS - 2
499 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
500 READ(LINE(IS:IE),CFMTI) NDEBDL
501 IF ( MMM .LE. 0 .OR. MMM .GT. 99 ) THEN
502 MDEBUG = 6
503 ELSE
504 MDEBUG = MMM
505 ENDIF
506
507C GET OUTPUT DIRECTORY FOR CALCULATIONS ON DEC-STATION OR TRANSPUTER
508 ELSEIF ( LINE(1:6) .EQ. 'DIRECT' ) THEN
509 DO 70 I=1,79
510 DSN(I:I) = ' '
511 70 CONTINUE
512 IS = 6
513 IF ( LINE(IS+1:80) .NE. ' ' ) THEN
514 71 CONTINUE
515 IS = IS + 1
516 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 71
517 IE = INDEX(LINE(IS:),' ') + IS - 2
518 IF ( IE-IS .GT. 63 ) THEN
519 IE = IS + 63
520 DSN(1:IE-IS+1) = LINE(IS:IE)
521 WRITE(MONIOU,*)
522 * 'DATAC: DATASETNAME TOO LONG AND TRUNCATED TO:',DSN(1:64)
523 ELSE
524 DSN(1:IE-IS+1) = LINE(IS:IE)
525 ENDIF
526 ENDIF
527
528C GET ENERGY CUTS FOR PARTICLE PRINTOUT
529 ELSEIF ( LINE(1:6) .EQ. 'ECTMAP' ) THEN
530 IS = 6
531 81 CONTINUE
532 IS = IS + 1
533 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 81
534 IE = INDEX(LINE(IS:),' ') + IS - 2
535 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
536 READ(LINE(IS:IE),CFMTF) ECTMAP
537
538C GET ENERGY CUTS FOR HADRONS, MUONS, ELECTRONS, AND PHOTONS
539 ELSEIF ( LINE(1:5) .EQ. 'ECUTS' ) THEN
540 IS = 5
541 91 CONTINUE
542 IS = IS + 1
543 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 91
544 IE = INDEX(LINE(IS:),' ') + IS - 2
545 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
546 READ(LINE(IS:IE),CFMTF) ELCUT(1)
547 IS = IE
548 92 CONTINUE
549 IS = IS + 1
550 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 92
551 IE = INDEX(LINE(IS:),' ') + IS - 2
552 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
553 READ(LINE(IS:IE),CFMTF) ELCUT(2)
554 IS = IE
555 93 CONTINUE
556 IS = IS + 1
557 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 93
558 IE = INDEX(LINE(IS:),' ') + IS - 2
559 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
560 READ(LINE(IS:IE),CFMTF) ELCUT(3)
561 IS = IE
562 94 CONTINUE
563 IS = IS + 1
564 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 94
565 IE = INDEX(LINE(IS:),' ') + IS - 2
566 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
567 READ(LINE(IS:IE),CFMTF) ELCUT(4)
568
569C GET FLAGS FOR ELECTROMAGNETIC OPTIONS (NKG, EGS)
570 ELSEIF ( LINE(1:6) .EQ. 'ELMFLG' ) THEN
571 IS = 6
572201 CONTINUE
573 IS = IS + 1
574 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 201
575 IE = INDEX(LINE(IS:),' ') + IS - 2
576 WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
577 READ(LINE(IS:IE),CFMTL) FNKG
578 IS = IE
579202 CONTINUE
580 IS = IS + 1
581 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 202
582 IE = INDEX(LINE(IS:),' ') + IS - 2
583 WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
584 READ(LINE(IS:IE),CFMTL) FEGS
585
586C GET ENERGY RANGE OF PRIMARY PARTICLE
587 ELSEIF ( LINE(1:6) .EQ. 'ERANGE' ) THEN
588 IS = 6
589211 CONTINUE
590 IS = IS + 1
591 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 211
592 IE = INDEX(LINE(IS:),' ') + IS - 2
593 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
594 READ(LINE(IS:IE),CFMTF) R1
595 IS = IE
596212 CONTINUE
597 IS = IS + 1
598 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 212
599 IE = INDEX(LINE(IS:),' ') + IS - 2
600 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
601 READ(LINE(IS:IE),CFMTF) R2
602 LLIMIT = MIN( R1, R2 )
603 ULIMIT = MAX( R1, R2 )
604
605C GET SLOPE OF ENERGY SPECTRUM OF PRIMARY PARTICLE
606 ELSEIF ( LINE(1:6) .EQ. 'ESLOPE' ) THEN
607 IS = 6
608221 CONTINUE
609 IS = IS + 1
610 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 221
611 IE = INDEX(LINE(IS:),' ') + IS - 2
612 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
613 READ(LINE(IS:IE),CFMTF) PSLOPE
614
615C GET EVENT NUMBER
616 ELSEIF ( LINE(1:5) .EQ. 'EVTNR' ) THEN
617 IS = 5
618231 CONTINUE
619 IS = IS + 1
620 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 231
621 IE = INDEX(LINE(IS:),' ') + IS - 2
622 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
623 READ(LINE(IS:IE),CFMTI) SHOWNO
624 SHOWNO = MAX( SHOWNO-1, 0 )
625
626C END OF DATA CARD INPUT
627 ELSEIF ( LINE(1:4) .EQ. 'EXIT' ) THEN
628 IF ( DEBUG ) THEN
629 WRITE(MONIOU,*) 'DATAC : END OF DATACARD INPUT'
630 ELSE
631 WRITE(MONIOU,*)
632 WRITE(MONIOU,*) 'END OF DATACARD INPUT'
633 ENDIF
634 RETURN
635
636C GET FIXED HEIGHT (G/CM**2) OF PARTICLE START
637 ELSEIF ( LINE(1:6) .EQ. 'FIXCHI' ) THEN
638 IS = 6
639241 CONTINUE
640 IS = IS + 1
641 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 241
642 IE = INDEX(LINE(IS:),' ') + IS - 2
643 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
644 READ(LINE(IS:IE),CFMTF) THICK0
645
646C GET FIXED HEIGHT OF FIRST INTERACTION AND FIRST TARGET
647 ELSEIF ( LINE(1:6) .EQ. 'FIXHEI' ) THEN
648 IS = 6
649251 CONTINUE
650 IS = IS + 1
651 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 251
652 IE = INDEX(LINE(IS:),' ') + IS - 2
653 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
654 READ(LINE(IS:IE),CFMTF) FIXHEI
655 IS = IE
656252 CONTINUE
657 IS = IS + 1
658 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 252
659 IE = INDEX(LINE(IS:),' ') + IS - 2
660 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
661 READ(LINE(IS:IE),CFMTI) N1STTR
662 IF ( FIXHEI .GT. 0. ) FIX1I = .TRUE.
663
664C GET FLAG FOR GHEISHA LOW ENERGY HADRONIC INTERACTION MODEL
665 ELSEIF ( LINE(1:6) .EQ. 'GHEISH' ) THEN
666 IS = 6
667261 CONTINUE
668 IS = IS + 1
669 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 261
670 IE = INDEX(LINE(IS:),' ') + IS - 2
671 WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
672 READ(LINE(IS:IE),CFMTL) GHEISH
673
674C GET FLAGS FOR HADRON INTERACTION OPTIONS
675 ELSEIF ( LINE(1:6) .EQ. 'HADFLG' ) THEN
676 IS = 6
677271 CONTINUE
678 IS = IS + 1
679 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 271
680 IE = INDEX(LINE(IS:),' ') + IS - 2
681 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
682 READ(LINE(IS:IE),CFMTI) NFLAIN
683 IS = IE
684272 CONTINUE
685 IS = IS + 1
686 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 272
687 IE = INDEX(LINE(IS:),' ') + IS - 2
688 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
689 READ(LINE(IS:IE),CFMTI) NFLDIF
690 IS = IE
691273 CONTINUE
692 IS = IS + 1
693 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 273
694 IE = INDEX(LINE(IS:),' ') + IS - 2
695 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
696 READ(LINE(IS:IE),CFMTI) NFLPI0
697 IS = IE
698274 CONTINUE
699 IS = IS + 1
700 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 274
701 IE = INDEX(LINE(IS:),' ') + IS - 2
702 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
703 READ(LINE(IS:IE),CFMTI) NFLPIF
704 IS = IE
705275 CONTINUE
706 IS = IS + 1
707 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 275
708 IE = INDEX(LINE(IS:),' ') + IS - 2
709 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
710 READ(LINE(IS:IE),CFMTI) NFLCHE
711 IS = IE
712276 CONTINUE
713 IS = IS + 1
714 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 276
715 IE = INDEX(LINE(IS:),' ') + IS - 2
716 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
717 READ(LINE(IS:IE),CFMTI) NFRAGM
718
719C GET NAME OF HOST COMPUTER
720 ELSEIF ( LINE(1:4) .EQ. 'HOST' ) THEN
721 DO 286 I=1,20
722 HOST(I:I) = ' '
723 286 CONTINUE
724 IS = 4
725 287 CONTINUE
726 IS = IS + 1
727 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 287
728 IE = INDEX(LINE(IS:),' ') + IS - 2
729 IF ( IE-IS .GT. 19 ) THEN
730 IE = IS + 19
731 HOST(1:IE-IS+1) = LINE(IS:IE)
732 WRITE(MONIOU,*)
733 * 'DATAC: HOSTNAME TOO LONG AND TRUNCATED TO:',HOST(1:20)
734 ELSE
735 HOST(1:IE-IS+1) = LINE(IS:IE)
736 ENDIF
737
738C GET PARAMETER FOR LONGITUDINAL DEVELOPMENT
739 ELSEIF ( LINE(1:5) .EQ. 'LONGI' ) THEN
740 IS = 5
741301 CONTINUE
742 IS = IS + 1
743 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 301
744 IE = INDEX(LINE(IS:),' ') + IS - 2
745 WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
746 READ(LINE(IS:IE),CFMTL) LLONGI
747 IS = IE
748302 CONTINUE
749 IS = IS + 1
750 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 302
751 IE = INDEX(LINE(IS:),' ') + IS - 2
752 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
753 READ(LINE(IS:IE),CFMTF) THSTEP
754 IS = IE
755303 CONTINUE
756 IS = IS + 1
757 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 303
758 IE = INDEX(LINE(IS:),' ') + IS - 2
759 WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
760 READ(LINE(IS:IE),CFMTL) FLGFIT
761
762C GET PARAMETERS OF MAGNETIC FIELD
763 ELSEIF ( LINE(1:6) .EQ. 'MAGNET' ) THEN
764 IS = 6
765311 CONTINUE
766 IS = IS + 1
767 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 311
768 IE = INDEX(LINE(IS:),' ') + IS - 2
769 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
770 READ(LINE(IS:IE),CFMTF) BX
771 IS = IE
772312 CONTINUE
773 IS = IS + 1
774 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 312
775 IE = INDEX(LINE(IS:),' ') + IS - 2
776 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
777 READ(LINE(IS:IE),CFMTF) BZ
778
779C GET NUMBER OF EVENTS TO BE PRINTED
780 ELSEIF ( LINE(1:6) .EQ. 'MAXPRT' ) THEN
781 IS = 6
782321 CONTINUE
783 IS = IS + 1
784 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 321
785 IE = INDEX(LINE(IS:),' ') + IS - 2
786 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
787 READ(LINE(IS:IE),CFMTI) MAXPRT
788 IF ( MAXPRT .LT. 0 ) MAXPRT = 10
789
790C GET FLAG FOR ADDITIONAL MUON INFORMATION ON PATAPE
791 ELSEIF ( LINE(1:6) .EQ. 'MUADDI' ) THEN
792 IS = 6
793331 CONTINUE
794 IS = IS + 1
795 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 331
796 IE = INDEX(LINE(IS:),' ') + IS - 2
797 WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
798 READ(LINE(IS:IE),CFMTL) FMUADD
799
800C GET FLAG FOR MUON MULTIPLE SCATTERING (T=MOLIERE, F=GAUSS)
801 ELSEIF ( LINE(1:6) .EQ. 'MUMULT' ) THEN
802 IS = 6
803336 CONTINUE
804 IS = IS + 1
805 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 336
806 IE = INDEX(LINE(IS:),' ') + IS - 2
807 WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
808 READ(LINE(IS:IE),CFMTL) FMOLI
809
810C GET NUMBER OF SHOWERS TO BE PRODUCED
811 ELSEIF ( LINE(1:5) .EQ. 'NSHOW' ) THEN
812 IS = 5
813341 CONTINUE
814 IS = IS + 1
815 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 341
816 IE = INDEX(LINE(IS:),' ') + IS - 2
817 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
818 READ(LINE(IS:IE),CFMTI) NSHOW
819 IF ( NSHOW .LE. 0 ) NSHOW = 1
820
821C GET HEIGHT OF OBSERVATION LEVELS
822 ELSEIF ( LINE(1:6) .EQ. 'OBSLEV' ) THEN
823 IOBSLV = IOBSLV + 1
824 IF ( IOBSLV .LE. 10 ) THEN
825 IS = 6
826351 CONTINUE
827 IS = IS + 1
828 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 351
829 IE = INDEX(LINE(IS:),' ') + IS - 2
830 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
831 READ(LINE(IS:IE),CFMTF) OBSLEV(IOBSLV)
832 NOBSLV = IOBSLV
833 ELSE
834 WRITE(MONIOU,*) 'DATAC : TOO MUCH OBSERVATION LEVELS,',
835 * ' IGNORE IT'
836 ENDIF
837
838C GET NEW MONITOR OUTPUT UNIT
839 ELSEIF ( LINE(1:6) .EQ. 'OUTPUT' ) THEN
840 IS = 6
841361 CONTINUE
842 IS = IS + 1
843 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 361
844 IE = INDEX(LINE(IS:),' ') + IS - 2
845 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
846 READ(LINE(IS:IE),CFMTI) MONNEW
847 WRITE(MONIOU,593) MONIOU,MONNEW
848 593 FORMAT(' ATTENTION'/' ========='/
849 * ' PRINTER OUTPUT REDIRECTED FROM UNIT ',I3,
850 * ' TO UNIT ',I3)
851 MONIOU = MONNEW
852
853C GET PHI OF PRIMARY PARTICLE
854 ELSEIF ( LINE(1:4) .EQ. 'PHIP' ) THEN
855 IS = 4
856371 CONTINUE
857 IS = IS + 1
858 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 371
859 IE = INDEX(LINE(IS:),' ') + IS - 2
860 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
861 READ(LINE(IS:IE),CFMTF) R1
862 IS = IE
863372 CONTINUE
864 IS = IS + 1
865 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 372
866 IE = INDEX(LINE(IS:),' ') + IS - 2
867 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
868 READ(LINE(IS:IE),CFMTF) R2
869 PHIPR(1) = MIN( R1, R2 )
870 PHIPR(2) = MAX( R1, R2 )
871
872C GET TYPE OF PRIMARY PARTICLE
873 ELSEIF ( LINE(1:6) .EQ. 'PRMPAR' ) THEN
874 IS = 6
875381 CONTINUE
876 IS = IS + 1
877 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 381
878 IE = INDEX(LINE(IS:),' ') + IS - 2
879 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
880 READ(LINE(IS:IE),CFMTI) NNTYP
881 PRMPAR(1) = NNTYP
882
883C GET WIDTH OF NKG LATERAL DISTRIBUTION
884 ELSEIF ( LINE(1:6) .EQ. 'RADNKG' ) THEN
885 IS = 6
886389 CONTINUE
887 IS = IS + 1
888 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 389
889 IE = INDEX(LINE(IS:),' ') + IS - 2
890 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
891 READ(LINE(IS:IE),CFMTF) RADNKG
892
893C GET RUN NUMBER
894 ELSEIF ( LINE(1:5) .EQ. 'RUNNR' ) THEN
895 IS = 5
896391 CONTINUE
897 IS = IS + 1
898 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 391
899 IE = INDEX(LINE(IS:),' ') + IS - 2
900 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
901 READ(LINE(IS:IE),CFMTI) NRRUN
902 NRRUN = ABS(NRRUN)
903
904C GET SEEDS OF RANDOM NUMBER SEQUENCES
905 ELSEIF ( LINE(1:4) .EQ. 'SEED' ) THEN
906 ISEQ = ISEQ + 1
907 IF ( ISEQ .LE. 10 ) THEN
908 IS = 4
909401 CONTINUE
910 IS = IS + 1
911 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 401
912 IE = INDEX(LINE(IS:),' ') + IS - 2
913 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
914 READ(LINE(IS:IE),CFMTI) ISEED(1,ISEQ)
915 IS = IE
916402 CONTINUE
917 IS = IS + 1
918 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 402
919 IE = INDEX(LINE(IS:),' ') + IS - 2
920 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
921 READ(LINE(IS:IE),CFMTI) ISEED(2,ISEQ)
922 IS = IE
923403 CONTINUE
924 IS = IS + 1
925 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 403
926 IE = INDEX(LINE(IS:),' ') + IS - 2
927 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
928 READ(LINE(IS:IE),CFMTI) ISEED(3,ISEQ)
929 NSEQ = ISEQ
930 ELSE
931 WRITE(MONIOU,*) 'DATAC : TOO MUCH RANDOM GENERATOR SEEDS,',
932 * ' IGNORE IT'
933 ENDIF
934
935C GET FACTOR FOR ELECTRON'S MULTIPLE SCATTERING LENGTH
936 ELSEIF ( LINE(1:6) .EQ. 'STEPFC' ) THEN
937 IS = 6
938406 CONTINUE
939 IS = IS + 1
940 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 406
941 IE = INDEX(LINE(IS:),' ') + IS - 2
942 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
943 READ(LINE(IS:IE),CFMTF) STEPFC
944
945C GET THETA OF PRIMARY PARTICLE
946 ELSEIF ( LINE(1:6) .EQ. 'THETAP' ) THEN
947 IS = 6
948411 CONTINUE
949 IS = IS + 1
950 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 411
951 IE = INDEX(LINE(IS:),' ') + IS - 2
952 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
953 READ(LINE(IS:IE),CFMTF) R1
954 IS = IE
955412 CONTINUE
956 IS = IS + 1
957 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 412
958 IE = INDEX(LINE(IS:),' ') + IS - 2
959 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
960 READ(LINE(IS:IE),CFMTF) R2
961 THETPR(1) = MIN( R1, R2 )
962 THETPR(2) = MAX( R1, R2 )
963
964C GET NAME OF USER
965 ELSEIF ( LINE(1:4) .EQ. 'USER' ) THEN
966 DO 416 I=1,20
967 USER(I:I) = ' '
968416 CONTINUE
969 IS = 4
970417 CONTINUE
971 IS = IS + 1
972 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 417
973 IE = INDEX(LINE(IS:),' ') + IS - 2
974 IF ( IE-IS .GT. 19 ) THEN
975 IE = IS + 19
976 USER(1:IE-IS+1) = LINE(IS:IE)
977 WRITE(MONIOU,*)
978 * 'DATAC: USERNAME TOO LONG AND TRUNCATED TO:',USER(1:20)
979 ELSE
980 USER(1:IE-IS+1) = LINE(IS:IE)
981 ENDIF
982
983C GET PARAMETER ISH0 FOR AMOUNT OF VENUS DEBUG
984 ELSEIF ( LINE(1:6) .EQ. 'VENDBG' ) THEN
985 IS = 6
986421 CONTINUE
987 IS = IS + 1
988 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 421
989 IE = INDEX(LINE(IS:),' ') + IS - 2
990 WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
991 READ(LINE(IS:IE),CFMTI) ISH0
992
993C GET VENUS PARAMETER WITH CODE WORD AND VALUE
994 ELSEIF ( LINE(1:6) .EQ. 'VENPAR' ) THEN
995 IPARAM = IPARAM + 1
996 IF ( IPARAM .LE. 100 ) THEN
997 PARCHA(IPARAM) = ' '
998 IS = 6
999431 CONTINUE
1000 IS = IS + 1
1001 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 431
1002 IE = INDEX(LINE(IS:),' ') + IS - 2
1003 IF ( IE-IS .GT. 5 ) THEN
1004 WRITE(MONIOU,*)
1005 * 'DATAC: VENUS PARAMETER NAME TOO LONG AND IGNORED'
1006 GOTO 1
1007 ELSE
1008 PARCHA(IPARAM) = LINE(IS:IE)
1009 ENDIF
1010 IS = IE
1011432 CONTINUE
1012 IS = IS + 1
1013 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 432
1014 IE = INDEX(LINE(IS:),' ') + IS - 2
1015 WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
1016 READ(LINE(IS:IE),CFMTF) PARVAL(IPARAM)
1017 NPARAM = IPARAM
1018 ELSE
1019 WRITE(MONIOU,*) 'DATAC : TOO MUCH VENUS PARAMETERS,',
1020 * ' IGNORE IT'
1021 ENDIF
1022
1023C GET FLAG FOR VENUS HIGH ENERGY HADRONIC INTERACTION MODEL
1024 ELSEIF ( LINE(1:5) .EQ. 'VENUS' ) THEN
1025 IS = 5
1026441 CONTINUE
1027 IS = IS + 1
1028 IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 441
1029 IE = INDEX(LINE(IS:),' ') + IS - 2
1030 WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
1031 READ(LINE(IS:IE),CFMTL) FVENUS
1032
1033c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
1034c get cerenkov file name with cts array specifications
1035 elseif ( LINE(1:6) .eq. 'CERTEL' ) then
1036 read(line(7:),'(I10)') nctels
1037 d2r = 3.1415926535897932385/180.0
1038 do 10 nct=1,nctels
1039 read(moniin,*) (ctpars(nct,m),m=1,7)
1040 ct = cos(ctpars(nct,ctthet)*d2r)
1041 st = sin(ctpars(nct,ctthet)*d2r)
1042 cp = cos(ctpars(nct,ctphi)*d2r)
1043 sp = sin(ctpars(nct,ctphi)*d2r)
1044 omega(nct,1,1) = cp
1045 omega(nct,1,2) = sp
1046 omega(nct,1,3) = 0.0
1047 omega(nct,2,1) = -ct*sp
1048 omega(nct,2,2) = ct*cp
1049 omega(nct,2,3) = st
1050 omega(nct,3,1) = st*sp
1051 omega(nct,3,2) = -st*cp
1052 omega(nct,3,3) = ct
1053c write(moniou,*) nct,(ctpars(nct,m),m=1,7)
1054 10 continue
1055c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
1056
1057C ILLEGAL KEYWORD
1058 ELSE
1059 WRITE(MONIOU,*) 'DATAC : UNKNOWN KEYWORD :',(LINE(I:I),I=1,6)
1060 ENDIF
1061
1062 GOTO 1
1063
1064C-----------------------------------------------------------------------
1065 1000 CONTINUE
1066 IF ( DEBUG ) THEN
1067 WRITE(MDEBUG,*) 'DATAC : NO MORE DIRECTIVES FOUND'
1068 ELSE
1069 WRITE(MONIOU,*) '*** NO MORE DIRECTIVES FOUND ***'
1070 ENDIF
1071
1072 RETURN
1073 END
Note: See TracBrowser for help on using the repository browser.