Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

datac.f@ 10099

Visit:

Last change on this file since 10099 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
3	C-----------------------------------------------------------------------
4	C DATA C(ARDS)
5	C
6	C READS DATA CARDS FROM UNIT 5 TO STEER RUN.
7	C READING IS FREE FORMAT WITH BLANK AS SEPARATOR.
8	C EACH KEYWORD STARTS ON A NEW LINE LEFTSHIFTED.
9	C THIS SUBROUTINE IS CALLED FROM START
10	C
11	C AUTHOR : J. KNAPP IK1 FZK KARLSRUHE
12	C-----------------------------------------------------------------------
13
14	c IMPLICIT NONE
15
16	c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
17	c All this lines are under test
18	c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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)
26	c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
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
148	c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
149	c All this lines are under test
150	c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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
169	c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
170	C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
171	c Angles for the "spinning" of a particle around the
172	c main axis of the CT
173	common /spinang/ spinxi
174	double precision spinxi
175	C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
176	*KEND.
177
178	DOUBLE PRECISION R1,R2
179	INTEGER I,IE,IOBSLV,IS,ISEQ,MMM,MONNEW,NNTYP
180	INTEGER IPARAM
181	CHARACTER LINE80, CFMTF7, CFMTI5, CFMTL4
182	DATA CFMTF/'(F10.0)'/, CFMTI/'(I11)'/, CFMTL/'(L1)'/
183	C-----------------------------------------------------------------------
184
185	C WRITE TITEL
186	WRITE(MONIOU,999)
187	999 FORMAT(' ',10('='),' USERS RUN DIRECTIVES FOR THIS SIMULATION ',
188	* 27('=')/)
189
190	C 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
240	C BORDER BETWEEN LOW AND HIGH ENERGY INTERACTION MODELS
241	C 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
281	C-----------------------------------------------------------------------
282	C 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
292	C-----------------------------------------------------------------------
293	1 CONTINUE
294
295	C ERASE 'LINE' BY FILLING WITH BLANKS
296	DO 2 I=1,80
297	LINE(I:I) = ' '
298	2 CONTINUE
299
300	C 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
311	C 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
324	C-----------------------------------------------------------------------
325	C INTERPRET KEYWORD AND READ PARAMETERS
326
327	C 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
332	C 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
342	C 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
387	C 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
397	C 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
407	c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
408	C 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
418	C 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
442	C 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
461	C 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
471	C 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
507	C 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
528	C 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
538	C 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
569	C GET FLAGS FOR ELECTROMAGNETIC OPTIONS (NKG, EGS)
570	ELSEIF ( LINE(1:6) .EQ. 'ELMFLG' ) THEN
571	IS = 6
572	201 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
579	202 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
586	C GET ENERGY RANGE OF PRIMARY PARTICLE
587	ELSEIF ( LINE(1:6) .EQ. 'ERANGE' ) THEN
588	IS = 6
589	211 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
596	212 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
605	C GET SLOPE OF ENERGY SPECTRUM OF PRIMARY PARTICLE
606	ELSEIF ( LINE(1:6) .EQ. 'ESLOPE' ) THEN
607	IS = 6
608	221 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
615	C GET EVENT NUMBER
616	ELSEIF ( LINE(1:5) .EQ. 'EVTNR' ) THEN
617	IS = 5
618	231 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
626	C 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
636	C GET FIXED HEIGHT (G/CM**2) OF PARTICLE START
637	ELSEIF ( LINE(1:6) .EQ. 'FIXCHI' ) THEN
638	IS = 6
639	241 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
646	C GET FIXED HEIGHT OF FIRST INTERACTION AND FIRST TARGET
647	ELSEIF ( LINE(1:6) .EQ. 'FIXHEI' ) THEN
648	IS = 6
649	251 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
656	252 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
664	C GET FLAG FOR GHEISHA LOW ENERGY HADRONIC INTERACTION MODEL
665	ELSEIF ( LINE(1:6) .EQ. 'GHEISH' ) THEN
666	IS = 6
667	261 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
674	C GET FLAGS FOR HADRON INTERACTION OPTIONS
675	ELSEIF ( LINE(1:6) .EQ. 'HADFLG' ) THEN
676	IS = 6
677	271 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
684	272 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
691	273 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
698	274 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
705	275 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
712	276 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
719	C 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
738	C GET PARAMETER FOR LONGITUDINAL DEVELOPMENT
739	ELSEIF ( LINE(1:5) .EQ. 'LONGI' ) THEN
740	IS = 5
741	301 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
748	302 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
755	303 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
762	C GET PARAMETERS OF MAGNETIC FIELD
763	ELSEIF ( LINE(1:6) .EQ. 'MAGNET' ) THEN
764	IS = 6
765	311 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
772	312 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
779	C GET NUMBER OF EVENTS TO BE PRINTED
780	ELSEIF ( LINE(1:6) .EQ. 'MAXPRT' ) THEN
781	IS = 6
782	321 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
790	C GET FLAG FOR ADDITIONAL MUON INFORMATION ON PATAPE
791	ELSEIF ( LINE(1:6) .EQ. 'MUADDI' ) THEN
792	IS = 6
793	331 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
800	C GET FLAG FOR MUON MULTIPLE SCATTERING (T=MOLIERE, F=GAUSS)
801	ELSEIF ( LINE(1:6) .EQ. 'MUMULT' ) THEN
802	IS = 6
803	336 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
810	C GET NUMBER OF SHOWERS TO BE PRODUCED
811	ELSEIF ( LINE(1:5) .EQ. 'NSHOW' ) THEN
812	IS = 5
813	341 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
821	C 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
826	351 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
838	C GET NEW MONITOR OUTPUT UNIT
839	ELSEIF ( LINE(1:6) .EQ. 'OUTPUT' ) THEN
840	IS = 6
841	361 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
853	C GET PHI OF PRIMARY PARTICLE
854	ELSEIF ( LINE(1:4) .EQ. 'PHIP' ) THEN
855	IS = 4
856	371 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
863	372 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
872	C GET TYPE OF PRIMARY PARTICLE
873	ELSEIF ( LINE(1:6) .EQ. 'PRMPAR' ) THEN
874	IS = 6
875	381 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
883	C GET WIDTH OF NKG LATERAL DISTRIBUTION
884	ELSEIF ( LINE(1:6) .EQ. 'RADNKG' ) THEN
885	IS = 6
886	389 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
893	C GET RUN NUMBER
894	ELSEIF ( LINE(1:5) .EQ. 'RUNNR' ) THEN
895	IS = 5
896	391 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
904	C 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
909	401 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
916	402 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
923	403 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
935	C GET FACTOR FOR ELECTRON'S MULTIPLE SCATTERING LENGTH
936	ELSEIF ( LINE(1:6) .EQ. 'STEPFC' ) THEN
937	IS = 6
938	406 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
945	C GET THETA OF PRIMARY PARTICLE
946	ELSEIF ( LINE(1:6) .EQ. 'THETAP' ) THEN
947	IS = 6
948	411 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
955	412 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
964	C GET NAME OF USER
965	ELSEIF ( LINE(1:4) .EQ. 'USER' ) THEN
966	DO 416 I=1,20
967	USER(I:I) = ' '
968	416 CONTINUE
969	IS = 4
970	417 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
983	C GET PARAMETER ISH0 FOR AMOUNT OF VENUS DEBUG
984	ELSEIF ( LINE(1:6) .EQ. 'VENDBG' ) THEN
985	IS = 6
986	421 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
993	C 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
999	431 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
1011	432 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
1023	C GET FLAG FOR VENUS HIGH ENERGY HADRONIC INTERACTION MODEL
1024	ELSEIF ( LINE(1:5) .EQ. 'VENUS' ) THEN
1025	IS = 5
1026	441 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
1033	c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
1034	c 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
1053	c write(moniou,*) nct,(ctpars(nct,m),m=1,7)
1054	10 continue
1055	c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
1056
1057	C ILLEGAL KEYWORD
1058	ELSE
1059	WRITE(MONIOU,*) 'DATAC : UNKNOWN KEYWORD :',(LINE(I:I),I=1,6)
1060	ENDIF
1061
1062	GOTO 1
1063
1064	C-----------------------------------------------------------------------
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.

Context Navigation

source: branches/start/MagicSoft/Simulation/Corsika/Mmcs/datac.f@ 10099

Download in other formats: