Choral
algebra_set.F90
Go to the documentation of this file.
1 
13 
15 
16  implicit none
17  private
18 
19  public :: shellsort_dec
20  public :: sort ! tested
21  public :: merge_sorted_set ! tested
22  public :: cap_sorted_set ! tested
23  public :: order_2 ! tested
24  public :: circperm
25 
26 contains
27 
28 
29 
36  subroutine merge_sorted_set(cpt, t, n, t1, n1, t2, n2)
37  integer, intent(out) :: cpt
38  integer, dimension(n ), intent(out) :: t
39  integer, dimension(n1), intent(in) :: t1
40  integer, dimension(n2), intent(in) :: t2
41  integer, intent(in) :: n, n1, n2
42 
43  integer :: ii, jj, ll
44 
45  cpt = 0
46  ii = 1 ; jj = 1
47  do while( (ii<=n1).AND.(jj<=n2) )
48 
49  if (t1(ii) < t2(jj)) then
50  cpt = cpt + 1
51 
52 #if DBG>0
53  if ( cpt > n ) then
54  write(*,*) "ERROR = algebra_set: merge_sorted_set: 1"
55  stop -1
56  end if
57 #endif
58 
59  t(cpt) = t1(ii)
60  ii = ii+1
61 
62  else if (t1(ii) > t2(jj)) then
63  cpt = cpt + 1
64 
65 #if DBG>0
66  if ( cpt > n ) then
67  write(*,*) "ERROR = algebra_set: merge_sorted_set: 2"
68  stop -1
69  end if
70 #endif
71 
72  t(cpt) = t2(jj)
73  jj = jj+1
74 
75  else ! equality case
76  cpt = cpt + 1
77 
78 #if DBG>0
79  if ( cpt > n ) then
80  write(*,*) "ERROR = algebra_set: merge_sorted_set: 3"
81  stop -1
82  end if
83 #endif
84 
85  t(cpt) = t1(ii)
86  ii = ii+1
87  jj = jj+1
88 
89  end if
90 
91  end do
92 
93  if (ii<=n1) then
94 
95  cpt = cpt + 1
96 
97  ll = n1 - ii
98 
99 #if DBG>0
100  if ( ll > n ) then
101  write(*,*) "ERROR = algebra_set: merge_sorted_set: 4"
102  stop -1
103  end if
104 #endif
105 
106  t(cpt:cpt+ll) = t1(ii:n1)
107  cpt = cpt + ll
108 
109  else if (jj<=n2) then
110 
111  cpt = cpt + 1
112 
113  ll = n2 - jj
114 
115 #if DBG>0
116  if ( ll > n ) then
117  write(*,*) "ERROR = algebra_set: merge_sorted_set: 5"
118  stop -1
119  end if
120 #endif
121 
122  t(cpt:cpt+ll) = t2(jj:n2)
123  cpt = cpt + ll
124 
125  end if
126 
127  end subroutine merge_sorted_set
128 
129 
134  subroutine cap_sorted_set(cpt, t, n, t1, n1, t2, n2)
135  integer, intent(out) :: cpt
136  integer, dimension(n ), intent(out) :: t
137  integer, dimension(n1), intent(in) :: t1
138  integer, dimension(n2), intent(in) :: t2
139  integer, intent(in) :: n, n1, n2
140 
141  integer :: ii, jj
142 
143  cpt = 0
144  ii = 1 ; jj = 1
145  do while( (ii<=n1).AND.(jj<=n2) )
146 
147  if (t1(ii) < t2(jj)) then
148  ii = ii+1
149 
150  else if (t1(ii) > t2(jj)) then
151  jj = jj+1
152 
153  else ! equality case
154  cpt = cpt + 1
155 
156 #if DBG>0
157  if ( cpt > n ) then
158  write(*,*) "ERROR = algebra_set: cap_sorted_set"
159  stop -1
160  end if
161 #endif
162 
163  t(cpt) = t1(ii)
164  ii = ii+1
165  jj = jj+1
166 
167  end if
168 
169  end do
170 
171  end subroutine cap_sorted_set
172 
173 
176  subroutine order_2(t)
177  integer, dimension(2), intent(inout) :: t
178 
179  integer :: temp
180 
181  if (t(1) > t(2) ) then
182  temp = t(1)
183  t(1) = t(2)
184  t(2) = temp
185  end if
186 
187  end subroutine order_2
188 
189 
197  subroutine sort(t, n)
198  integer, dimension(n), intent(inout) :: t
199  integer , intent(in) :: n
200 
201  integer :: ii, jj, a
202 
203  do jj=2, n
204  a=t(jj)
205 
206  do ii=jj-1,1,-1
207  if (t(ii)<=a) goto 10
208  t(ii+1)=t(ii)
209  end do
210  ii=0
211 10 t(ii+1)=a
212  end do
213 
214  end subroutine sort
215 
216 
222  subroutine shellsort_dec(t, new_i, n)
223  integer, dimension(n), intent(in) :: t
224  integer, dimension(n), intent(out) :: new_i
225  integer , intent(in) :: n
226 
227  integer :: i,j,z,gap,i_z
228 
229  i = 0
230  new_i = (/ (i, i=1,n) /)
231 
232  ! Recherche du Gap optimal,
233  ! defini par U(n) = 3U(n-1)+1 et U(n)<n
234  gap = 0
235  do while (gap<n)
236  gap = 3*gap+1
237  end do
238 
239  do while (gap>2)
240 
241  gap = gap/3 ! Calcul du gap
242 
243  ! Tri par insertion
244  do i=1+gap,n
245  i_z = new_i(i) ! Indice de la valeur a inserer
246  z = t(i_z) ! Valeur à insérer
247  j = i-gap
248  do while (j>=1)
249  if (z>t(new_i(j))) then
250  new_i(j+gap)=new_i(j) ! Decalage
251  j = j-gap
252  else
253  exit
254  end if
255  end do
256  new_i(j+gap)=i_z ! Insertion
257  end do
258  end do
259 
260  end subroutine shellsort_dec
261 
262 
270  subroutine circperm(E)
271  integer, dimension(:), intent(inout) :: E
272 
273  integer :: en, n
274 
275  n = size(e, 1)
276  en = e(n)
277 
278  e(2:n) = e(1:n-1)
279  e(1) = en
280 
281  end subroutine circperm
282 
283 end module algebra_set
284 
285 
subroutine, public merge_sorted_set(cpt, t, n, t1, n1, t2, n2)
t(1:cpt) = merge of the two arrays t1 and t2 of size n1 and n2
Definition: algebra_set.F90:37
ALGEBRAIC OPERATIONS ON SETS
Definition: algebra_set.F90:14
subroutine, public order_2(t)
order an array of size 2
subroutine, public sort(t, n)
Sorts the array t of length N in ascending order by the straight insertion method.
subroutine, public circperm(E)
Circular permutation of an array of integer.
subroutine, public cap_sorted_set(cpt, t, n, t1, n1, t2, n2)
t(1:cpt) = t1(1:n1) \cap t2(1:n2)
subroutine, public shellsort_dec(t, new_i, n)
Sort integer array : shell sort.