← Back to branch summary

~maddevelopers/mg5amcnlo/2.5.3

« back to all changes in this revision

Viewing changes to Template/NLO/Source/basecode.f

  • Committer: olivier-mattelaer
  • Date: 2017-03-08 12:31:17 UTC
  • Revision ID: olivier-mattelaer-20170308123117-h0zkqjyh9sihsc61
empty version to have an effective freeze of the code

Show diffs side-by-side

added added

removed removed

Lines of Context:
Template/NLO/Source/basecode.f
1
 
      subroutine basecode_test
2
 
      implicit none
3
 
      integer imax
4
 
      parameter (imax = 8)
5
 
      integer icode,iarray(imax),ibase,i,j
6
 
      logical done
7
 
 
8
 
      ibase = 3
9
 
c      do i=0,ibase**3-1
10
 
c         call decode(i,iarray,ibase,imax)
11
 
c         call encode(icode,iarray,ibase,imax)
12
 
c         write(*,*) i,icode,"=",(iarray(j),j=1,imax)
13
 
c      enddo
14
 
      icode = 0
15
 
      call decode(icode,iarray,ibase,imax)
16
 
      iarray(2)=1
17
 
      iarray(4)=1
18
 
      iarray(5)=1
19
 
      iarray(7)=1
20
 
      done = .false.
21
 
      write(*,*) (iarray(j),j=1,imax)
22
 
      do while (.not. done)
23
 
         write(*,*) (iarray(j),j=1,imax)
24
 
         call increment_array(iarray,imax,ibase,done)
25
 
      enddo
26
 
      end
27
 
      
28
 
 
29
 
      subroutine EnCode(icode,iarray,ibase,imax)
30
 
c******************************************************************************
31
 
c     Turns array of integers (iarray) values range (0,ibase-1) into a single
32
 
c     integer icode. icode = Sum[ iarray(k) * ibase^k]
33
 
c******************************************************************************
34
 
      implicit none
35
 
c
36
 
c     Arguments
37
 
c
38
 
      integer imax           !Number of integers to encode
39
 
      integer icode          !Output encoded value of iarray
40
 
      integer iarray(imax)   !Input values to be encoded
41
 
      integer ibase          !Base for encoding
42
 
 
43
 
c
44
 
c     Local
45
 
c     
46
 
      integer i
47
 
c-----
48
 
c  Begin Code
49
 
c-----
50
 
      icode = 0
51
 
      do i = 1, imax
52
 
         if (iarray(i) .ge. 0 .and. iarray(i) .lt. ibase) then 
53
 
            icode = icode + iarray(i)*ibase**(i-1)
54
 
         else
55
 
            write(*,*) 'Error invalid number to be encoded',i,iarray(i)
56
 
         endif
57
 
      enddo
58
 
      end
59
 
 
60
 
      subroutine DeCode(icode,iarray,ibase,imax)
61
 
c******************************************************************************
62
 
c     Decodes icode, into base integers used to create it.
63
 
c     integer icode. icode = Sum[ iarray(k) * ibase^k]
64
 
c******************************************************************************
65
 
      implicit none
66
 
c
67
 
c     Arguments
68
 
c
69
 
      integer imax           !Number of integers to encode
70
 
      integer icode          !Input encoded value of iarray
71
 
      integer iarray(imax)   !Output decoded values icode
72
 
      integer ibase          !Base for encoding
73
 
 
74
 
c
75
 
c     Local
76
 
c     
77
 
      integer i, jcode
78
 
c-----
79
 
c  Begin Code
80
 
c-----
81
 
      jcode = icode          !create copy for use
82
 
      do i =  imax, 1, -1
83
 
         iarray(i) = 0
84
 
         do while (jcode .ge. ibase**(i-1) .and. iarray(i) .lt. ibase)
85
 
            jcode = jcode-ibase**(i-1)
86
 
            iarray(i)=iarray(i)+1
87
 
         enddo
88
 
      enddo
89
 
      end
90
 
 
91
 
      subroutine increment_array(iarray,imax,ibase,done)
92
 
c************************************************************************
93
 
c     Increments iarray     
94
 
c************************************************************************
95
 
      implicit none
96
 
c
97
 
c     Arguments
98
 
c
99
 
      integer imax          !Input, number of elements in iarray
100
 
      integer ibase         !Base for incrementing, 0 is skipped
101
 
      integer iarray(imax)  !Output:Array of values being incremented
102
 
      logical done          !Output:Set when no more incrementing
103
 
c
104
 
c     Local
105
 
c
106
 
      integer i,j
107
 
      logical found
108
 
c-----
109
 
c  Begin Code
110
 
c-----
111
 
      found = .false.
112
 
      i = 1
113
 
      do while (i .le. imax .and. .not. found)
114
 
         if (iarray(i) .eq. 0) then    !don't increment this
115
 
            i=i+1
116
 
         elseif (iarray(i) .lt. ibase-1) then
117
 
            found = .true.
118
 
            iarray(i)=iarray(i)+1
119
 
         else
120
 
            iarray(i)=1
121
 
            i=i+1
122
 
         endif
123
 
      enddo
124
 
      done = .not. found
125
 
      end
126
 
 
127