← Back to branch summary

~maddevelopers/mg5amcnlo/WWW5_caching

« back to all changes in this revision

Viewing changes to users/mardelcourt/PROC_427003/PROC_427003/Source/basecode.f

  • Committer: John Doe
  • Date: 2013-03-25 20:27:02 UTC
  • Revision ID: john.doe@gmail.com-20130325202702-5sk3t1r8h33ca4p4
first clean version

Show diffs side-by-side

added added

removed removed

Lines of Context:
users/mardelcourt/PROC_427003/PROC_427003/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