← Back to branch summary

~maddevelopers/mg5amcnlo/2.9.4

« back to all changes in this revision

Viewing changes to vendor/StdHEP/src/stdhep/stdxrd.F

pass to v2.0.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
vendor/StdHEP/src/stdhep/stdxrd.F
 
1
      subroutine stdxrd(ilbl,istream,lok)
 
2
 
 
3
C...Purpose: to read a buffer or an event from the standard common block.
 
4
C
 
5
C       returns ilbl & lok
 
6
C
 
7
C               ilbl = 1   - standard HEPEVT common block
 
8
C               ilbl = 2   - standard HEPEVT common block and HEPEV2
 
9
C               ilbl = 3   - stdevent struct
 
10
C               ilbl = 4   - standard HEPEVT common block with Les Houches
 
11
C               ilbl = 5   - standard HEPEVT common block with Les Houches
 
12
C                               and multiple collisions
 
13
C               ilbl = 11  - HEPEUP common block
 
14
C               ilbl = 12  - HEPRUP common block
 
15
C               ilbl = 100 - STDHEP begin run record
 
16
C               ilbl = 200 - STDHEP end run record
 
17
C
 
18
C               lok = 0 if no problems were encountered
 
19
C
 
20
 
 
21
#include "stdcnt.inc"
 
22
#include "stdlun.inc"
 
23
#include "stdhd.inc"
 
24
#include "mcfio.inc"
 
25
 
 
26
      integer ilbl,lok,istream
 
27
      integer i
 
28
      integer xdr_stdhep, xdr_stdhep_multi, xdr_stdhep_cm1
 
29
      external xdr_stdhep, xdr_stdhep_multi, xdr_stdhep_cm1
 
30
      integer xdr_stdhep_cxx, xdr_stdhep_4, xdr_stdhep_4_multi
 
31
      external xdr_stdhep_cxx, xdr_stdhep_4, xdr_stdhep_4_multi
 
32
      integer xdr_hepeup, xdr_heprup
 
33
      external xdr_hepeup, xdr_heprup
 
34
 
 
35
      logical lfirst
 
36
      data lfirst/.TRUE./
 
37
      save lfirst
 
38
 
 
39
C...print version number if this is the first call
 
40
      if(lfirst)then
 
41
        call stdversn
 
42
        nstdrd = 0
 
43
        nlhrd = 0
 
44
        lfirst=.FALSE.
 
45
      endif
 
46
 
 
47
      lok = 0
 
48
c...get the next xdr event
 
49
      if(mcfio_NextEvent(istream) .ne. MCFIO_RUNNING)then
 
50
        call mcfio_InfoStreamInt(istream,MCFIO_STATUS,istat)
 
51
        if(istat .eq. MCFIO_EOF) go to 800
 
52
        if(istat .eq. MCFIO_RUNNING)  go to 700
 
53
        go to 900
 
54
      endif
 
55
c...what blocks are in this event?
 
56
      call mcfio_InfoEventInt(istream,MCFIO_NUMBLOCKS,numblocks)
 
57
      call mcfio_InfoEventInt(istream,MCFIO_BLOCKIDS,blkids)
 
58
      do i=1,numblocks
 
59
        if(blkids(i).eq.MCFIO_STDHEP)then
 
60
c...zero stdhep common 
 
61
          call stdzero
 
62
c...fill stdhep common 
 
63
          if(mcfio_block(istream,MCFIO_STDHEP,xdr_stdhep) .eq. -1)
 
64
     1          go to 700
 
65
          ilbl = 1
 
66
          call stdtcopy(2,istream,lok)
 
67
          if(lok.eq.0) nstdrd = nstdrd + 1
 
68
        elseif(blkids(i).eq.MCFIO_STDHEPM)then
 
69
c...zero stdhep common 
 
70
          call stdzero
 
71
c...fill stdhep common 
 
72
          if(mcfio_block(istream,MCFIO_STDHEPM,xdr_stdhep_multi)
 
73
     1         .eq. -1) go to 700
 
74
          ilbl = 2
 
75
          nstdrd = nstdrd + 1
 
76
        elseif(blkids(i).eq.MCFIO_STDHEP4)then
 
77
c...zero stdhep common 
 
78
          call stdzero
 
79
c...fill stdhep common 
 
80
          if(mcfio_block(istream,MCFIO_STDHEP4,xdr_stdhep_4) .eq. -1)
 
81
     1          go to 700
 
82
          ilbl = 4
 
83
          call stdtcopy(2,istream,lok)
 
84
          if(lok.eq.0) nstdrd = nstdrd + 1
 
85
        elseif(blkids(i).eq.MCFIO_STDHEP4M)then
 
86
c...zero stdhep common 
 
87
          call stdzero
 
88
c...fill stdhep common 
 
89
          if(mcfio_block(istream,MCFIO_STDHEP4M,xdr_stdhep_4_multi)
 
90
     1         .eq. -1) go to 700
 
91
          ilbl = 5
 
92
          nstdrd = nstdrd + 1
 
93
        elseif(blkids(i).eq.MCFIO_STDHEPCXX)then
 
94
c...zero stdhep common 
 
95
          call stdzero
 
96
c...fill stdevent struct
 
97
c          if(mcfio_block(istream,MCFIO_STDHEPCXX,xdr_stdhep_cxx)
 
98
c     1         .eq. -1) go to 700
 
99
          ilbl = 3
 
100
          write (lnhout,703) 
 
101
c...fix stdhep common from stdevent
 
102
c         call copy_stdevent
 
103
c          nstdrd = nstdrd + 1
 
104
        elseif(blkids(i).eq.MCFIO_HEPEUP)then
 
105
c...Les Houches event - fill hepeup common
 
106
          if(mcfio_block(istream,MCFIO_HEPEUP,xdr_hepeup)
 
107
     1         .eq. -1) go to 700
 
108
          ilbl = 11
 
109
          nlhrd = nlhrd + 1
 
110
        elseif(blkids(i).eq.MCFIO_HEPRUP)then
 
111
c...Les Houches event - fill heprup common
 
112
          if(mcfio_block(istream,MCFIO_HEPRUP,xdr_heprup)
 
113
     1         .eq. -1) go to 700
 
114
          ilbl = 12
 
115
          nlhrd = nlhrd + 1
 
116
        elseif(blkids(i).eq.MCFIO_STDHEPBEG)then
 
117
c...begin run event - fill stdcm1 common
 
118
          if(mcfio_block(istream,MCFIO_STDHEPBEG,xdr_stdhep_cm1)
 
119
     1         .eq. -1) go to 700
 
120
          ilbl = 100
 
121
        elseif(blkids(i).eq.MCFIO_STDHEPEND)then
 
122
c...end run event - fill stdcm1 common
 
123
          if(mcfio_block(istream,MCFIO_STDHEPEND,xdr_stdhep_cm1)
 
124
     1         .eq. -1) go to 700
 
125
          ilbl = 200
 
126
        endif
 
127
      enddo
 
128
      return
 
129
      
 
130
  700 write (lnhout,701)
 
131
      lok=1
 
132
      return
 
133
  800 write (lnhout,801)
 
134
      lok=1
 
135
      return
 
136
  900 write (lnhout,901)
 
137
      lok=2
 
138
      stop
 
139
  701 format(/5X,'STDXRD: unable to read xdr block')
 
140
  703 format(/5X,'STDXRD: stdevent struct cannot be processed')
 
141
  801 format(/5X,'STDXRD: end of file found')
 
142
  901 format(/5X,'STDXRD: unrecognized status - stop')
 
143
      end
 
144