← Back to branch summary

~maddevelopers/mg5amcnlo/2.9.4

« back to all changes in this revision

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

pass to v2.0.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
vendor/StdHEP/src/stdhep/stdsort.F
 
1
 
 
2
      subroutine STDSORT
 
3
 
 
4
C... sort HEPEVT by daughter list
 
5
 
 
6
#include "stdhep.inc"
 
7
#include "stdlun.inc"
 
8
 
 
9
      integer IST(NMXHEP),ID(NMXHEP),JMO(2,NMXHEP),JDA(2,NMXHEP)
 
10
      double precision P1(5,NMXHEP),V1(4,NMXHEP)
 
11
      integer I,IN,J,K,L,LIST(NMXHEP),IREV(NMXHEP)
 
12
      integer LSIZE
 
13
      PARAMETER (LSIZE=100)
 
14
      integer NDAU,LDTR(LSIZE),LD,IP,JN1,JN2,JTMP
 
15
 
 
16
C...zero the temporary arrays
 
17
      do I=1,NMXHEP
 
18
        LIST(I)=0
 
19
        IREV(I)=0
 
20
        IST(I)=0
 
21
        ID(I)=0
 
22
        do J=1,2
 
23
          JMO(J,I)=0
 
24
          JDA(J,I)=0
 
25
        enddo
 
26
        do J=1,5
 
27
          P1(J,I)=0.
 
28
        enddo
 
29
        do J=1,4
 
30
          V1(J,I)=0.
 
31
        enddo
 
32
      enddo
 
33
 
 
34
      IN = 0
 
35
C... start by listing all particles with no parent
 
36
C...       or otherwise from initial state
 
37
      do I=1,NHEP
 
38
        if((JMOHEP(1,I).EQ.0 .AND. JMOHEP(2,I).EQ.0) .OR.
 
39
     1           (ISTHEP(I).EQ.3))then
 
40
          IN = IN+1
 
41
          LIST(I) = IN
 
42
          IREV(IN) = I
 
43
          IST(IN) = ISTHEP(I)
 
44
          ID(IN) = IDHEP(I)
 
45
          do J=1,5
 
46
            P1(J,IN) = PHEP(J,I)
 
47
          enddo
 
48
          do J=1,4
 
49
            V1(J,IN) = VHEP(J,I)
 
50
          enddo
 
51
        endif
 
52
      enddo
 
53
C... now start adding the remaining particles
 
54
      JN1 = 1
 
55
      JN2 = IN
 
56
      do WHILE (JN2.GE.JN1)
 
57
        do I=JN1,JN2
 
58
C... find the daughters of this particle and add them
 
59
          call STDDAUTRLST(IREV(I),NDAU,LSIZE,LDTR)
 
60
          if(NDAU.GT.0)then
 
61
            LD = MIN(NDAU,LSIZE)
 
62
            do K=1,LD
 
63
              IP = LDTR(K)
 
64
C... has this particle been listed already?
 
65
              if(LIST(IP).EQ.0)then
 
66
                IN = IN+1
 
67
                LIST(IP) = IN
 
68
                IREV(IN) = IP
 
69
                IST(IN) = ISTHEP(IP)
 
70
                ID(IN) = IDHEP(IP)
 
71
                do J=1,5
 
72
                  P1(J,IN) = PHEP(J,IP)
 
73
                enddo
 
74
                do J=1,4
 
75
                  V1(J,IN) = VHEP(J,IP)
 
76
                enddo
 
77
              else
 
78
                write(lnhout,1001) IP
 
79
              endif
 
80
            enddo
 
81
          endif
 
82
        enddo
 
83
        JN1 = JN2+1
 
84
        JN2 = IN
 
85
      enddo
 
86
C...did we miss anything?
 
87
      do I=1,NHEP
 
88
        if(LIST(I).EQ.0)then
 
89
D         write(lnhout,1002) I
 
90
          IN = IN+1
 
91
          LIST(I) = IN
 
92
          IREV(IN) = I
 
93
          IST(IN) = ISTHEP(I)
 
94
          ID(IN) = IDHEP(I)
 
95
          do J=1,5
 
96
            P1(J,IN) = PHEP(J,I)
 
97
          enddo
 
98
          do J=1,4
 
99
            V1(J,IN) = VHEP(J,I)
 
100
          enddo
 
101
C...get daughters of this particle
 
102
          if(JDAHEP(1,I).GT.0)then
 
103
      JN1 = IN
 
104
      JN2 = IN
 
105
      do WHILE (JN2.GE.JN1)
 
106
        do L=JN1,JN2
 
107
C... find the daughters of this particle and add them
 
108
          call STDDAUTRLST(IREV(L),NDAU,LSIZE,LDTR)
 
109
          if(NDAU.GT.0)then
 
110
            LD = MIN(NDAU,LSIZE)
 
111
            do K=1,LD
 
112
              IP = LDTR(K)
 
113
C... has this particle been listed already?
 
114
              if(LIST(IP).EQ.0)then
 
115
                IN = IN+1
 
116
                LIST(IP) = IN
 
117
                IREV(IN) = IP
 
118
                IST(IN) = ISTHEP(IP)
 
119
                ID(IN) = IDHEP(IP)
 
120
                do J=1,5
 
121
                  P1(J,IN) = PHEP(J,IP)
 
122
                enddo
 
123
                do J=1,4
 
124
                  V1(J,IN) = VHEP(J,IP)
 
125
                enddo
 
126
              else
 
127
                write(lnhout,1001) IP
 
128
              endif
 
129
            enddo
 
130
          endif
 
131
        enddo
 
132
        JN1 = JN2+1
 
133
        JN2 = IN
 
134
      enddo
 
135
          endif
 
136
        endif
 
137
      enddo
 
138
C...get mother/daughter info
 
139
      do I=1,IN
 
140
        do K=1,2
 
141
          JTMP = JDAHEP(K,IREV(I))
 
142
          JDA(K,I) = LIST(JTMP)
 
143
          JTMP = JMOHEP(K,IREV(I))
 
144
          JMO(K,I) = LIST(JTMP)
 
145
        enddo
 
146
      enddo
 
147
C...put it all back into the common block
 
148
      if(IN.NE.NHEP) write(lnhout,1003) IN,NHEP
 
149
      do I=1,IN
 
150
        ISTHEP(I) = IST(I)
 
151
        IDHEP(I) = ID(I)
 
152
        do J=1,2
 
153
          JMOHEP(J,I) = JMO(J,I)
 
154
          JDAHEP(J,I) = JDA(J,I)
 
155
        enddo
 
156
        do J=1,5
 
157
          PHEP(J,I) = P1(J,I)
 
158
        enddo
 
159
        do J=1,4
 
160
          VHEP(J,I) = V1(J,I)
 
161
        enddo
 
162
      enddo
 
163
      return
 
164
1001  format(' STDSORT: particle ',I5,' is out of order')
 
165
1002  format(' STDSORT: particle ',I5,
 
166
     1      ' was not found in daughter search')
 
167
1003  format(' STDSORT: WARNING found only ',I4,' of ',I4,' particles')
 
168
      end