C++InterfacetoTauola
demo/phodem.f
1 /* copyright(c) 1991-2012 free software foundation, inc.
2  this file is part of the gnu c library.
3 
4  the gnu c library is free software; you can redistribute it and/or
5  modify it under the terms of the gnu lesser general Public
6  license as published by the free software foundation; either
7  version 2.1 of the license, or(at your option) any later version.
8 
9  the gnu c library is distributed in the hope that it will be useful,
10  but without any warranty; without even the implied warranty of
11  merchantability or fitness for a particular purpose. see the gnu
12  lesser general Public license for more details.
13 
14  you should have received a copy of the gnu lesser general Public
15  license along with the gnu c library; if not, see
16  <http://www.gnu.org/licenses/>. */
17 
18 
19 /* this header is separate from features.h so that the compiler can
20  include it implicitly at the start of every compilation. it must
21  not itself include <features.h> or any other header that includes
22  <features.h> because the implicit include comes before any feature
23  test macros that may be defined in a source file before it first
24  explicitly includes a system header. gcc knows the name of this
25  header in order to preinclude it. */
26 
27 /* we do support the iec 559 math functionality, real and complex. */
28 
29 /* wchar_t uses iso/iec 10646 (2nd ed., published 2011-03-15) /
30  unicode 6.0. */
31 
32 /* we do not support c11 <threads.h>. */
33 
34 c.----------------------------------------------------------------------
35 c.
36 c. photos: photon radiation in decays test program
37 c.
38 c. purpose: example of application of photos.
39 c.
40 c. input parameters: none
41 c.
42 c. output parameters: none
43 c.
44 c. author(s): b. van eijk, e. barberio created at: 31/05/90
45 c. last update: 05/06/90
46 c.
47 c.----------------------------------------------------------------------
48  PROGRAM photst
49 c IMPLICIT NONE
50  INTEGER event,nhep0
51 c this is the hepevt class in old style. no d_h_ class pre-name
52  INTEGER nmxhep
53  parameter(nmxhep=10000)
54  REAL*8 phep, vhep ! to be real*4/ *8 depending on host
55  INTEGER nevhep,nhep,isthep,idhep,jmohep,
56  $ jdahep
57  COMMON /hepevt/
58  $ nevhep, ! serial number
59  $ nhep, ! number of particles
60  $ isthep(nmxhep), ! status code
61  $ idhep(nmxhep), ! particle ident KF
62  $ jmohep(2,nmxhep), ! parent particles
63  $ jdahep(2,nmxhep), ! childreen particles
64  $ phep(5,nmxhep), ! four-momentum, mass [GeV]
65  $ vhep(4,nmxhep) ! vertex [mm]
66 * ----------------------------------------------------------------------
67  LOGICAL qedrad
68  COMMON /phoqed/
69  $ qedrad(nmxhep) ! Photos flag
70 * ----------------------------------------------------------------------
71  SAVE hepevt,phoqed
72  INTEGER phlun
73  common/pholun/phlun
74 c--
75 c-- initialise photos
76  CALL phoini
77 c--
78 c-- loop over jetset event until photos has generated one or more pho-
79 c-- tons. Do this for 10 jetset events. the event record is printed
80 c-- before and after photon emission.
81  DO 20 event=1,1
82  CALL lueevt(4,91.)
83 c--
84 c-- conversion to /hepevt/ standard
85  CALL luhepc(1)
86 c--
87 c-- Write event record before emission...
88  nevhep=event
89  CALL phodmp
90  nhep0=nhep
91 c--
92 c-- generate photon(s)... arbitrary enforced generation.
93 c-- normally line: IF (nhep.EQ.nhep0) goto 10 must be absent!
94  10 CALL photos(1)
95  IF (nhep.EQ.nhep0) goto 10
96 c--
97 c-- Write event record...
98  WRITE(phlun,9050)
99  WRITE(phlun,9040)
100  CALL phodmp
101  20 CONTINUE
102  WRITE(phlun,9000)
103  WRITE(phlun,9010)
104  WRITE(phlun,9020)
105  WRITE(phlun,9030)
106  WRITE(phlun,9020)
107  WRITE(phlun,9010)
108  stop
109  9000 FORMAT(1h1)
110  9010 FORMAT(1h ,80('*'))
111  9020 FORMAT(1h ,'*',78x,'*')
112  9030 FORMAT(1h ,'**** PHOTOS Test Run has successfully ended',32x,
113  &' ****')
114  9040 FORMAT(1h ,26x,'=== after PHOTOS: ===')
115  9050 FORMAT(1h0,80('='))
116  END