Context Navigation

mrgrnk.F90 @ 3736

Last change on this file since 3736 was 3358, checked in by idelkadi, 6 years ago
Implementation de la nouvelle version COSPv2 dans LMDZ. Pour compiler avec makelmdz_fcma utiliser l'option "-cosp2 true"
File size: 19.7 KB

Line
1	! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2	! Copyright (c) 2015, Regents of the University of Colorado
3	! All rights reserved.
4	!
5	! Redistribution and use in source and binary forms, with or without modification, are
6	! permitted provided that the following conditions are met:
7	!
8	! 1. Redistributions of source code must retain the above copyright notice, this list of
9	! conditions and the following disclaimer.
10	!
11	! 2. Redistributions in binary form must reproduce the above copyright notice, this list
12	! of conditions and the following disclaimer in the documentation and/or other
13	! materials provided with the distribution.
14	!
15	! 3. Neither the name of the copyright holder nor the names of its contributors may be
16	! used to endorse or promote products derived from this software without specific prior
17	! written permission.
18	!
19	! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY
20	! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
21	! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
22	! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
23	! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
24	! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
25	! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
26	! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
27	! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28	!
29	! History:
30	! May 2015: Dustin Swales - Modified for COSPv2.0
31	!
32	! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
33	Module m_mrgrnk
34	USE COSP_KINDS, ONLY: wp
35	Integer, Parameter :: kdp = selected_real_kind(15)
36	public :: mrgrnk
37	private :: kdp
38	private :: R_mrgrnk, I_mrgrnk, D_mrgrnk
39
40	interface mrgrnk
41	! module procedure D_mrgrnk, R_mrgrnk, I_mrgrnk
42	module procedure R_mrgrnk, I_mrgrnk
43
44	end interface
45	contains
46
47	Subroutine D_mrgrnk (XDONT, IRNGT)
48	! __________________________________________________________
49	! MRGRNK = Merge-sort ranking of an array
50	! For performance reasons, the first 2 passes are taken
51	! out of the standard loop, and use dedicated coding.
52	! __________________________________________________________
53	! __________________________________________________________
54	Real (wp), Dimension (:), Intent (In) :: XDONT
55	Integer, Dimension (:), Intent (Out) :: IRNGT
56	! __________________________________________________________
57	Real (wp) :: XVALA, XVALB
58	!
59	Integer, Dimension (SIZE(IRNGT)) :: JWRKT
60	Integer :: LMTNA, LMTNC, IRNG1, IRNG2
61	Integer :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB
62	!
63	NVAL = Min (SIZE(XDONT), SIZE(IRNGT))
64	Select Case (NVAL)
65	Case (:0)
66	Return
67	Case (1)
68	IRNGT (1) = 1
69	Return
70	Case Default
71	Continue
72	End Select
73	!
74	! Fill-in the index array, creating ordered couples
75	!
76	Do IIND = 2, NVAL, 2
77	If (XDONT(IIND-1) <= XDONT(IIND)) Then
78	IRNGT (IIND-1) = IIND - 1
79	IRNGT (IIND) = IIND
80	Else
81	IRNGT (IIND-1) = IIND
82	IRNGT (IIND) = IIND - 1
83	End If
84	End Do
85	If (Modulo(NVAL, 2) /= 0) Then
86	IRNGT (NVAL) = NVAL
87	End If
88	!
89	! We will now have ordered subsets A - B - A - B - ...
90	! and merge A and B couples into C - C - ...
91	!
92	LMTNA = 2
93	LMTNC = 4
94	!
95	! First iteration. The length of the ordered subsets goes from 2 to 4
96	!
97	Do
98	If (NVAL <= 2) Exit
99	!
100	! Loop on merges of A and B into C
101	!
102	Do IWRKD = 0, NVAL - 1, 4
103	If ((IWRKD+4) > NVAL) Then
104	If ((IWRKD+2) >= NVAL) Exit
105	!
106	! 1 2 3
107	!
108	If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Exit
109	!
110	! 1 3 2
111	!
112	If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
113	IRNG2 = IRNGT (IWRKD+2)
114	IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
115	IRNGT (IWRKD+3) = IRNG2
116	!
117	! 3 1 2
118	!
119	Else
120	IRNG1 = IRNGT (IWRKD+1)
121	IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
122	IRNGT (IWRKD+3) = IRNGT (IWRKD+2)
123	IRNGT (IWRKD+2) = IRNG1
124	End If
125	Exit
126	End If
127	!
128	! 1 2 3 4
129	!
130	If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Cycle
131	!
132	! 1 3 x x
133	!
134	If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
135	IRNG2 = IRNGT (IWRKD+2)
136	IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
137	If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
138	! 1 3 2 4
139	IRNGT (IWRKD+3) = IRNG2
140	Else
141	! 1 3 4 2
142	IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
143	IRNGT (IWRKD+4) = IRNG2
144	End If
145	!
146	! 3 x x x
147	!
148	Else
149	IRNG1 = IRNGT (IWRKD+1)
150	IRNG2 = IRNGT (IWRKD+2)
151	IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
152	If (XDONT(IRNG1) <= XDONT(IRNGT(IWRKD+4))) Then
153	IRNGT (IWRKD+2) = IRNG1
154	If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
155	! 3 1 2 4
156	IRNGT (IWRKD+3) = IRNG2
157	Else
158	! 3 1 4 2
159	IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
160	IRNGT (IWRKD+4) = IRNG2
161	End If
162	Else
163	! 3 4 1 2
164	IRNGT (IWRKD+2) = IRNGT (IWRKD+4)
165	IRNGT (IWRKD+3) = IRNG1
166	IRNGT (IWRKD+4) = IRNG2
167	End If
168	End If
169	End Do
170	!
171	! The Cs become As and Bs
172	!
173	LMTNA = 4
174	Exit
175	End Do
176	!
177	! Iteration loop. Each time, the length of the ordered subsets
178	! is doubled.
179	!
180	Do
181	If (LMTNA >= NVAL) Exit
182	IWRKF = 0
183	LMTNC = 2 * LMTNC
184	!
185	! Loop on merges of A and B into C
186	!
187	Do
188	IWRK = IWRKF
189	IWRKD = IWRKF + 1
190	JINDA = IWRKF + LMTNA
191	IWRKF = IWRKF + LMTNC
192	If (IWRKF >= NVAL) Then
193	If (JINDA >= NVAL) Exit
194	IWRKF = NVAL
195	End If
196	IINDA = 1
197	IINDB = JINDA + 1
198	!
199	! Shortcut for the case when the max of A is smaller
200	! than the min of B. This line may be activated when the
201	! initial set is already close to sorted.
202	!
203	! IF (XDONT(IRNGT(JINDA)) <= XDONT(IRNGT(IINDB))) CYCLE
204	!
205	! One steps in the C subset, that we build in the final rank array
206	!
207	! Make a copy of the rank array for the merge iteration
208	!
209	JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA)
210	!
211	XVALA = XDONT (JWRKT(IINDA))
212	XVALB = XDONT (IRNGT(IINDB))
213	!
214	Do
215	IWRK = IWRK + 1
216	!
217	! We still have unprocessed values in both A and B
218	!
219	If (XVALA > XVALB) Then
220	IRNGT (IWRK) = IRNGT (IINDB)
221	IINDB = IINDB + 1
222	If (IINDB > IWRKF) Then
223	! Only A still with unprocessed values
224	IRNGT (IWRK+1:IWRKF) = JWRKT (IINDA:LMTNA)
225	Exit
226	End If
227	XVALB = XDONT (IRNGT(IINDB))
228	Else
229	IRNGT (IWRK) = JWRKT (IINDA)
230	IINDA = IINDA + 1
231	If (IINDA > LMTNA) Exit! Only B still with unprocessed values
232	XVALA = XDONT (JWRKT(IINDA))
233	End If
234	!
235	End Do
236	End Do
237	!
238	! The Cs become As and Bs
239	!
240	LMTNA = 2 * LMTNA
241	End Do
242	!
243	Return
244	!
245	End Subroutine D_mrgrnk
246
247	Subroutine R_mrgrnk (XDONT, IRNGT)
248	! __________________________________________________________
249	! MRGRNK = Merge-sort ranking of an array
250	! For performance reasons, the first 2 passes are taken
251	! out of the standard loop, and use dedicated coding.
252	! __________________________________________________________
253	! _________________________________________________________
254	Real(wp), Dimension (:), Intent (In) :: XDONT
255	Integer, Dimension (:), Intent (Out) :: IRNGT
256	! __________________________________________________________
257	Real(wp) :: XVALA, XVALB
258	!
259	Integer, Dimension (SIZE(IRNGT)) :: JWRKT
260	Integer :: LMTNA, LMTNC, IRNG1, IRNG2
261	Integer :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB
262	!
263	NVAL = Min (SIZE(XDONT), SIZE(IRNGT))
264	Select Case (NVAL)
265	Case (:0)
266	Return
267	Case (1)
268	IRNGT (1) = 1
269	Return
270	Case Default
271	Continue
272	End Select
273	!
274	! Fill-in the index array, creating ordered couples
275	!
276	Do IIND = 2, NVAL, 2
277	If (XDONT(IIND-1) <= XDONT(IIND)) Then
278	IRNGT (IIND-1) = IIND - 1
279	IRNGT (IIND) = IIND
280	Else
281	IRNGT (IIND-1) = IIND
282	IRNGT (IIND) = IIND - 1
283	End If
284	End Do
285	If (Modulo(NVAL, 2) /= 0) Then
286	IRNGT (NVAL) = NVAL
287	End If
288	!
289	! We will now have ordered subsets A - B - A - B - ...
290	! and merge A and B couples into C - C - ...
291	!
292	LMTNA = 2
293	LMTNC = 4
294	!
295	! First iteration. The length of the ordered subsets goes from 2 to 4
296	!
297	Do
298	If (NVAL <= 2) Exit
299	!
300	! Loop on merges of A and B into C
301	!
302	Do IWRKD = 0, NVAL - 1, 4
303	If ((IWRKD+4) > NVAL) Then
304	If ((IWRKD+2) >= NVAL) Exit
305	!
306	! 1 2 3
307	!
308	If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Exit
309	!
310	! 1 3 2
311	!
312	If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
313	IRNG2 = IRNGT (IWRKD+2)
314	IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
315	IRNGT (IWRKD+3) = IRNG2
316	!
317	! 3 1 2
318	!
319	Else
320	IRNG1 = IRNGT (IWRKD+1)
321	IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
322	IRNGT (IWRKD+3) = IRNGT (IWRKD+2)
323	IRNGT (IWRKD+2) = IRNG1
324	End If
325	Exit
326	End If
327	!
328	! 1 2 3 4
329	!
330	If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Cycle
331	!
332	! 1 3 x x
333	!
334	If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
335	IRNG2 = IRNGT (IWRKD+2)
336	IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
337	If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
338	! 1 3 2 4
339	IRNGT (IWRKD+3) = IRNG2
340	Else
341	! 1 3 4 2
342	IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
343	IRNGT (IWRKD+4) = IRNG2
344	End If
345	!
346	! 3 x x x
347	!
348	Else
349	IRNG1 = IRNGT (IWRKD+1)
350	IRNG2 = IRNGT (IWRKD+2)
351	IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
352	If (XDONT(IRNG1) <= XDONT(IRNGT(IWRKD+4))) Then
353	IRNGT (IWRKD+2) = IRNG1
354	If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
355	! 3 1 2 4
356	IRNGT (IWRKD+3) = IRNG2
357	Else
358	! 3 1 4 2
359	IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
360	IRNGT (IWRKD+4) = IRNG2
361	End If
362	Else
363	! 3 4 1 2
364	IRNGT (IWRKD+2) = IRNGT (IWRKD+4)
365	IRNGT (IWRKD+3) = IRNG1
366	IRNGT (IWRKD+4) = IRNG2
367	End If
368	End If
369	End Do
370	!
371	! The Cs become As and Bs
372	!
373	LMTNA = 4
374	Exit
375	End Do
376	!
377	! Iteration loop. Each time, the length of the ordered subsets
378	! is doubled.
379	!
380	Do
381	If (LMTNA >= NVAL) Exit
382	IWRKF = 0
383	LMTNC = 2 * LMTNC
384	!
385	! Loop on merges of A and B into C
386	!
387	Do
388	IWRK = IWRKF
389	IWRKD = IWRKF + 1
390	JINDA = IWRKF + LMTNA
391	IWRKF = IWRKF + LMTNC
392	If (IWRKF >= NVAL) Then
393	If (JINDA >= NVAL) Exit
394	IWRKF = NVAL
395	End If
396	IINDA = 1
397	IINDB = JINDA + 1
398	!
399	! Shortcut for the case when the max of A is smaller
400	! than the min of B. This line may be activated when the
401	! initial set is already close to sorted.
402	!
403	! IF (XDONT(IRNGT(JINDA)) <= XDONT(IRNGT(IINDB))) CYCLE
404	!
405	! One steps in the C subset, that we build in the final rank array
406	!
407	! Make a copy of the rank array for the merge iteration
408	!
409	JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA)
410	!
411	XVALA = XDONT (JWRKT(IINDA))
412	XVALB = XDONT (IRNGT(IINDB))
413	!
414	Do
415	IWRK = IWRK + 1
416	!
417	! We still have unprocessed values in both A and B
418	!
419	If (XVALA > XVALB) Then
420	IRNGT (IWRK) = IRNGT (IINDB)
421	IINDB = IINDB + 1
422	If (IINDB > IWRKF) Then
423	! Only A still with unprocessed values
424	IRNGT (IWRK+1:IWRKF) = JWRKT (IINDA:LMTNA)
425	Exit
426	End If
427	XVALB = XDONT (IRNGT(IINDB))
428	Else
429	IRNGT (IWRK) = JWRKT (IINDA)
430	IINDA = IINDA + 1
431	If (IINDA > LMTNA) Exit! Only B still with unprocessed values
432	XVALA = XDONT (JWRKT(IINDA))
433	End If
434	!
435	End Do
436	End Do
437	!
438	! The Cs become As and Bs
439	!
440	LMTNA = 2 * LMTNA
441	End Do
442	!
443	Return
444	!
445	End Subroutine R_mrgrnk
446	Subroutine I_mrgrnk (XDONT, IRNGT)
447	! __________________________________________________________
448	! MRGRNK = Merge-sort ranking of an array
449	! For performance reasons, the first 2 passes are taken
450	! out of the standard loop, and use dedicated coding.
451	! __________________________________________________________
452	! __________________________________________________________
453	Integer, Dimension (:), Intent (In) :: XDONT
454	Integer, Dimension (:), Intent (Out) :: IRNGT
455	! __________________________________________________________
456	Integer :: XVALA, XVALB
457	!
458	Integer, Dimension (SIZE(IRNGT)) :: JWRKT
459	Integer :: LMTNA, LMTNC, IRNG1, IRNG2
460	Integer :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB
461	!
462	NVAL = Min (SIZE(XDONT), SIZE(IRNGT))
463	Select Case (NVAL)
464	Case (:0)
465	Return
466	Case (1)
467	IRNGT (1) = 1
468	Return
469	Case Default
470	Continue
471	End Select
472	!
473	! Fill-in the index array, creating ordered couples
474	!
475	Do IIND = 2, NVAL, 2
476	If (XDONT(IIND-1) <= XDONT(IIND)) Then
477	IRNGT (IIND-1) = IIND - 1
478	IRNGT (IIND) = IIND
479	Else
480	IRNGT (IIND-1) = IIND
481	IRNGT (IIND) = IIND - 1
482	End If
483	End Do
484	If (Modulo(NVAL, 2) /= 0) Then
485	IRNGT (NVAL) = NVAL
486	End If
487	!
488	! We will now have ordered subsets A - B - A - B - ...
489	! and merge A and B couples into C - C - ...
490	!
491	LMTNA = 2
492	LMTNC = 4
493	!
494	! First iteration. The length of the ordered subsets goes from 2 to 4
495	!
496	Do
497	If (NVAL <= 2) Exit
498	!
499	! Loop on merges of A and B into C
500	!
501	Do IWRKD = 0, NVAL - 1, 4
502	If ((IWRKD+4) > NVAL) Then
503	If ((IWRKD+2) >= NVAL) Exit
504	!
505	! 1 2 3
506	!
507	If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Exit
508	!
509	! 1 3 2
510	!
511	If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
512	IRNG2 = IRNGT (IWRKD+2)
513	IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
514	IRNGT (IWRKD+3) = IRNG2
515	!
516	! 3 1 2
517	!
518	Else
519	IRNG1 = IRNGT (IWRKD+1)
520	IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
521	IRNGT (IWRKD+3) = IRNGT (IWRKD+2)
522	IRNGT (IWRKD+2) = IRNG1
523	End If
524	Exit
525	End If
526	!
527	! 1 2 3 4
528	!
529	If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Cycle
530	!
531	! 1 3 x x
532	!
533	If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
534	IRNG2 = IRNGT (IWRKD+2)
535	IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
536	If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
537	! 1 3 2 4
538	IRNGT (IWRKD+3) = IRNG2
539	Else
540	! 1 3 4 2
541	IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
542	IRNGT (IWRKD+4) = IRNG2
543	End If
544	!
545	! 3 x x x
546	!
547	Else
548	IRNG1 = IRNGT (IWRKD+1)
549	IRNG2 = IRNGT (IWRKD+2)
550	IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
551	If (XDONT(IRNG1) <= XDONT(IRNGT(IWRKD+4))) Then
552	IRNGT (IWRKD+2) = IRNG1
553	If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
554	! 3 1 2 4
555	IRNGT (IWRKD+3) = IRNG2
556	Else
557	! 3 1 4 2
558	IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
559	IRNGT (IWRKD+4) = IRNG2
560	End If
561	Else
562	! 3 4 1 2
563	IRNGT (IWRKD+2) = IRNGT (IWRKD+4)
564	IRNGT (IWRKD+3) = IRNG1
565	IRNGT (IWRKD+4) = IRNG2
566	End If
567	End If
568	End Do
569	!
570	! The Cs become As and Bs
571	!
572	LMTNA = 4
573	Exit
574	End Do
575	!
576	! Iteration loop. Each time, the length of the ordered subsets
577	! is doubled.
578	!
579	Do
580	If (LMTNA >= NVAL) Exit
581	IWRKF = 0
582	LMTNC = 2 * LMTNC
583	!
584	! Loop on merges of A and B into C
585	!
586	Do
587	IWRK = IWRKF
588	IWRKD = IWRKF + 1
589	JINDA = IWRKF + LMTNA
590	IWRKF = IWRKF + LMTNC
591	If (IWRKF >= NVAL) Then
592	If (JINDA >= NVAL) Exit
593	IWRKF = NVAL
594	End If
595	IINDA = 1
596	IINDB = JINDA + 1
597	!
598	! Shortcut for the case when the max of A is smaller
599	! than the min of B. This line may be activated when the
600	! initial set is already close to sorted.
601	!
602	! IF (XDONT(IRNGT(JINDA)) <= XDONT(IRNGT(IINDB))) CYCLE
603	!
604	! One steps in the C subset, that we build in the final rank array
605	!
606	! Make a copy of the rank array for the merge iteration
607	!
608	JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA)
609	!
610	XVALA = XDONT (JWRKT(IINDA))
611	XVALB = XDONT (IRNGT(IINDB))
612	!
613	Do
614	IWRK = IWRK + 1
615	!
616	! We still have unprocessed values in both A and B
617	!
618	If (XVALA > XVALB) Then
619	IRNGT (IWRK) = IRNGT (IINDB)
620	IINDB = IINDB + 1
621	If (IINDB > IWRKF) Then
622	! Only A still with unprocessed values
623	IRNGT (IWRK+1:IWRKF) = JWRKT (IINDA:LMTNA)
624	Exit
625	End If
626	XVALB = XDONT (IRNGT(IINDB))
627	Else
628	IRNGT (IWRK) = JWRKT (IINDA)
629	IINDA = IINDA + 1
630	If (IINDA > LMTNA) Exit! Only B still with unprocessed values
631	XVALA = XDONT (JWRKT(IINDA))
632	End If
633	!
634	End Do
635	End Do
636	!
637	! The Cs become As and Bs
638	!
639	LMTNA = 2 * LMTNA
640	End Do
641	!
642	Return
643	!
644	End Subroutine I_mrgrnk
645	end module m_mrgrnk

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format