source: trunk/MagicSoft/Simulation/Corsika/Mmcs/ausgab.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: 3.2 KB
Line 
1 SUBROUTINE AUSGAB
2C
3C*********************************************************************
4C DESIGN : D. HECK IK3 FZK KARLSRUHE
5C*********************************************************************
6C WE USE AUSGAB TO FILL OUTPAR WITH PARTICLE COORDINATES.
7C*********************************************************************
8*KEEP,GENER.
9 COMMON /GENER/ GEN,ALEVEL
10 DOUBLE PRECISION GEN,ALEVEL
11*KEND.
12 COMMON/MISC/KMPI,KMPO,DUNIT,NOSCAT,MED(6),RHOR(6),IRAYLR(6)
13*KEEP,PARPAR.
14 COMMON /PARPAR/ CURPAR,SECPAR,PRMPAR,OUTPAR,C,
15 * E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
16 DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
17 * C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
18 INTEGER ITYPE,LEVL
19*KEEP,RUNPAR.
20 COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
21 * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
22 * MONIOU,MDEBUG,NUCNUC,
23 * CETAPE,
24 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
25 * N1STTR,MDBASE,
26 * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
27 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
28 * ,GHEISH,GHESIG
29 COMMON /RUNPAC/ DSN,HOST,USER
30 DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
31 REAL STEPFC
32 INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
33 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
34 * N1STTR,MDBASE
35 INTEGER CETAPE
36 CHARACTER*79 DSN
37 CHARACTER*20 HOST,USER
38
39 LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
40 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
41 * ,GHEISH,GHESIG
42*KEEP,STACKE.
43 COMMON/STACKE/ E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
44 DOUBLE PRECISION E(60),TIME(60)
45 REAL X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
46 INTEGER IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
47*KEND.
48 COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
49 DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
50 COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
51 COMMON/ACLOCK/NCLOCK,JCLOCK
52 NOBS=IOBS(NP)
53C*** ANGLE WITH RESPECT TO X AXIS
54 IF (U(NP)**2+V(NP)**2.GT.3.E-38) THEN
55 ANGLEX = -ATAN2(V(NP),U(NP))
56 ELSE
57 ANGLEX = 0.
58 END IF
59C*** PARTICLE IS WRITTEN IN OUTPUT BUFFER ARRAY
60 OUTPAR(1)=IQ(NP)
61 OUTPAR(2)=E(NP)*0.001D0
62 OUTPAR(3)=W(NP)
63 OUTPAR(4)=ANGLEX
64 OUTPAR(5)=-Z(NP)
65 OUTPAR(6)=TIME(NP)
66 OUTPAR(7)=X(NP)
67 OUTPAR(8)=-Y(NP)
68 OUTPAR(9)=IGEN(NP)
69 OUTPAR(10)=ALEVEL
70 LEVL=NOBS
71 CALL OUTPUT
72 IF (DEBUG.OR.(JCLOCK.GT.1 .AND. NCLOCK.GT.JCLOCK)) THEN
73 WRITE(MDEBUG,* )'AUSGAB: NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
74 XX=X(NP)
75 YY=-Y(NP)
76 ZZ=-Z(NP)
77 ANGLEZ=W(NP)
78 ANGLX=ANGLEX
79 ETOT=E(NP)*.001
80 WRITE(KMPO,170) IQ(NP),ETOT,ANGLEZ,ANGLX,ZZ,TIME(NP)*1.0D3,XX,YY,
81 * IGEN(NP)
82170 FORMAT(' AUSGAB:',10X,I4,1X,F10.4,1X,F7.4,1X,F7.4,1X,F9.0, F9.6,
83 * 1X,F10.1,1X,F10.1,1X,I3
84 * )
85 END IF
86 RETURN
87 END
Note: See TracBrowser for help on using the repository browser.