← Back to branch summary

~maddevelopers/mg5amcnlo/2.9.4

« back to all changes in this revision

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

pass to v2.0.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
vendor/StdHEP/src/stdhep/dpmhep.F
 
1
      subroutine dpmhep(mconv)
 
2
 
 
3
C...Convert DPMJET event record to and from the HEPEVT common block
 
4
C...convert (mconv=1) from DPMJET numbering scheme to StdHep numbering scheme
 
5
C...     or (mconv=2) from StdHep numbering scheme to DPMJET numbering scheme
 
6
 
 
7
C at this time, the particle ID numbers are assumed to be correct.
 
8
 
 
9
      IMPLICIT NONE
 
10
 
 
11
#include "stdhep.inc"
 
12
#include "stdlun.inc"
 
13
#include "hkkevt.inc"
 
14
 
 
15
      integer dpmtran
 
16
      external dpmtran
 
17
 
 
18
      integer i,j,l,mconv
 
19
 
 
20
      logical lfirst
 
21
      data lfirst/.true./
 
22
      save lfirst
 
23
 
 
24
C...print version number if this is the first call
 
25
      if(lfirst)then
 
26
        call stdversn
 
27
        lfirst=.false.
 
28
      endif
 
29
      if(mconv.EQ.1) then
 
30
C...convert from DPMJET to HEPEVT
 
31
        nhep = nhkk
 
32
        nevhep = nevhkk
 
33
        if(nhep.le.nmxhep)then
 
34
          do i=1,nhep
 
35
             isthep(i) = isthkk(i)
 
36
             idhep(i) = dpmtran(idhkk(i),mconv)
 
37
             do j=1,2
 
38
               jmohep(j,i) = jmohkk(j,i)
 
39
               jdahep(j,i) = jdahkk(j,i)
 
40
             enddo
 
41
             do j=1,5
 
42
               phep(j,i) = phkk(j,i)
 
43
             enddo
 
44
             do j=1,4
 
45
               vhep(j,i) = vhkk(j,i)
 
46
             enddo
 
47
          enddo
 
48
        else
 
49
          write(lnhout,1001) nhkk,nmxhep
 
50
          i = 0
 
51
          do l=1,nhkk
 
52
            if(isthkk(l).eq.1 .or. isthkk(l).eq.-1
 
53
     1          .or. isthkk(l).eq.1001)then
 
54
               i = i+1
 
55
               if(i.gt.nmxhep) then
 
56
                  write(lnhout,1004)
 
57
                  return
 
58
               endif
 
59
               isthep(i) = isthkk(i)
 
60
               idhep(i) = dpmtran(idhkk(i),mconv)
 
61
               do j=1,2
 
62
                 jmohep(j,i) = jmohkk(j,i)
 
63
                 jdahep(j,i) = jdahkk(j,i)
 
64
               enddo
 
65
               do j=1,5
 
66
                 phep(j,i) = phkk(j,i)
 
67
               enddo
 
68
               do j=1,4
 
69
                 vhep(j,i) = vhkk(j,i)
 
70
               enddo
 
71
            endif
 
72
          enddo
 
73
        endif
 
74
      elseif(mconv.EQ.2) then
 
75
C...convert from HEPEVT to DPMJET
 
76
        write(lnhout,1002)
 
77
      else
 
78
C...unsupported option
 
79
        write(lnhout,1003)
 
80
      endif
 
81
      return
 
82
1001  format(' DPMHEP: too many particles (',I4,
 
83
     1       ') for hepevt common block'/
 
84
     2       ' will only save isthkk = 1, -1, and 1001')
 
85
 
 
86
1002  format(' DPMHEP: conversion back to DPM not yet enabled')
 
87
1003  format(' DPMHEP: unallowed conversion option')
 
88
1004  format(' DPMHEP: still too many particles - truncating event')
 
89
      end