source: CPL/oasis3/trunk/src/lib/anaisg/src/qlsort.f @ 1677

Last change on this file since 1677 was 1677, checked in by aclsce, 13 years ago

Imported oasis3 (tag ipslcm5a) from cvs server to svn server (igcmg project).

File size: 3.1 KB
Line 
1      SUBROUTINE qlsort (prho, kto, kwg)
2C****
3C               *****************************
4C               * OASIS ROUTINE  -  LEVEL 3 *
5C               * -------------     ------- *
6C               *****************************
7C
8C**** *qlsort* - Sort kwg numbers with adresses
9C
10C     Purpose:
11C     -------
12C     Given kwg real in prho, this routine sort them and
13C     rearrange the array kto in the same way.
14C
15C     N.B: The method is a trivial one. the first element is assumed 
16C     to be the smallest and then tested against the following 
17C     one. If an element is smallest a permutation is made, 
18C     and the testing goes on with the next elements. There
19C     is no need to test again the  elements previously tested
20C     as they are known to be greater. At the end of the loop
21C     the smallest is in first position, and we repeat the 
22C     the procedure with the array starting in position two
23C     and so on.
24C
25C**   Interface:
26C     ---------
27C       *CALL*  *qlsort (prho, kto, kwg)*
28C
29C     Input:
30C     -----
31C                prho  : array to be sorted
32C                kto   : array to be re-arranged as prho
33C                kwg   : size of prho and kto
34C
35C     Output:
36C     ------
37C                prho  : the sorted array
38C                kto   : the re-arranged array
39C
40C     Workspace:
41C     ---------
42C     None
43C
44C     External:
45C     --------
46C     None
47C
48C     References:
49C     ----------
50C     O. Thual, Simple ocean-atmosphere interpolation. 
51C               Part A: The method, EPICOA 0629 (1992)
52C               Part B: Software implementation, EPICOA 0630 (1992)
53C     See also OASIS manual (1995)
54C
55C     History:
56C     -------
57C       Version   Programmer     Date      Description
58C       -------   ----------     ----      ----------- 
59C       1.1       O. Thual       93/04/15  created 
60C       2.0       L. Terray      95/10/01  modified: new structure
61C
62C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
63C
64C* ---------------------------- Include files ---------------------------
65C
66      USE mod_kinds_oasis
67      USE mod_unit
68C
69C* ---------------------------- Argument declarations -------------------
70C
71      REAL (kind=ip_realwp_p) prho(kwg)
72      INTEGER (kind=ip_intwp_p) kto(kwg)
73C
74C* ---------------------------- Poema verses ----------------------------
75C
76C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
77C   
78C*    1. Sorting algorithm
79C        -----------------
80C     
81C* If kwg is equal to one no sorting is needed
82C
83      IF (kwg .EQ. 1) RETURN
84C
85C* Loop on all the positions
86C
87      ikwgm = kwg - 1
88      DO 110 jwg = 1, ikwgm
89        ijwgp = jwg + 1
90C
91C* Loop on the element following the position
92C
93        DO 120 jnext = ijwgp, kwg 
94          zsmal = prho(jwg)
95          zbig = prho(jnext)
96C
97C* Testing the smallness assumption
98C
99          IF (zsmal .GT. zbig) THEN
100C
101C* Permutation of prho
102C 
103              prho(jnext) = zsmal
104              prho(jwg) = zbig
105C
106C* Permutation of kto
107C
108              ikbig = kto(jnext)
109              kto(jnext) = kto(jwg)
110              kto(jwg) = ikbig
111          ENDIF
112 120    CONTINUE
113 110  CONTINUE
114C
115C* End of routine
116C
117      RETURN
118      END
Note: See TracBrowser for help on using the repository browser.