### File: C:\NOAA\NEMS_11731\src\chem\gocart\src\GMAO_Shared\MAPL_Base\MAPL_Sort.F90

```1
2     #define ASSERT_(A) if(.not.(A))call exit(1)
3
4
5     !  \$Id: MAPL_Sort.F90,v 1.6 2009/04/22 15:05:32 f4mjs Exp \$
6
7     !=============================================================================
8     !BOP
9
10     ! !MODULE: MAPL_Sort   -- A utility to sort integers
11
12     ! !INTERFACE:
13
14     module MAPL_SortMod
15
16       implicit none
17       private
18
19     ! !PUBLIC ROUTINES:
20
21       public MAPL_Sort
22
23     ! !DESCRIPTION:
24     !
25     !   {\tt GEOS\_Sort} is a utility to do a quicksort on integers. The general
26     !   interface is:
27     !\bv
28     !       subroutine MAPL_Sort(A)
29     !         integer(kind=[4,8]),       intent(INOUT) :: A(:)
30     !         integer(kind=4), optional, intent(INOUT) :: B(size(A))
31     !
32     !       subroutine MAPL_Sort(A,B)
33     !         integer(kind=[4,8]),       intent(INOUT) :: A(:)
34     !         integer(kind=4),           intent(INOUT) :: B(:,:)
35     !         integer,         optional, intent(IN   ) :: DIM
36     !\ev
37     !   {\tt GEOS\_Sort} sorts A in ascending order and reorders the data in B
38     !   in the same order; i.e., it does the same exchanges to B as were done
39     !   to A in sorting it.  If, for example, on input B(:) contains the ordered integers
40     !   from 1 to size(A), on output it will contain the positions of the elements of
41     !   the sorted A in the unsorted A. In the second signature, DIM=1 corresponds
42     !   to a B ordered as B(size(A),:), whereas DIM=2 corresponds to B(:,size(A)).
43     !   The default is DIM=2. The quicksort is coded in C and does not appear here.
44
45     !EOP
46     !=============================================================================
47
48     interface MAPL_Sort
49        module procedure SORT1L
50        module procedure SORT1R
51        module procedure SORT1D
52        module procedure SORT1S
53        module procedure SORT2L
54        module procedure SORT2S
55        module procedure SORT2DS
56     end interface
57
58     contains
59
60     subroutine SORT1S(A,B)
61       integer(kind=4),           intent(INOUT) :: A(:)
62       integer(kind=4), optional, intent(INOUT) :: B(:)
63       if(present(B)) then
64          call QSORTS(A,B,size(A),1)
65       else
66          call QSORTS(A,A,size(A),0)
67       endif
68     end subroutine SORT1S
69
70     subroutine SORT1R(A,B)
71       integer(kind=4),           intent(INOUT) :: A(:)
72       real   (kind=4),           intent(INOUT) :: B(:)
73       call QSORTS(A,B,size(A),1)
74     end subroutine SORT1R
75
76     subroutine SORT1D(A,B)
77       integer(kind=4),           intent(INOUT) :: A(:)
78       real   (kind=8),           intent(INOUT) :: B(:)
79       call QSORTS(A,B,size(A),2)
80     end subroutine SORT1D
81
82     subroutine SORT1L(A,B)
83       integer(kind=8), intent(INOUT) :: A(:)
84       integer(kind=4), optional, intent(INOUT) :: B(:)
85       if(present(B)) then
86          call QSORT(A,B,size(A),1)
87       else
88          call QSORT(A,A,size(A),0)
89       endif
90     end subroutine SORT1L
91
92     subroutine SORT2S(A,B,DIM)
93       integer(kind=4),   intent(INOUT) :: A(:)
94       integer(kind=4),   intent(INOUT) :: B(:,:)
95       integer, optional, intent(IN   ) :: DIM
96
97       integer :: uDIM
98
99       if(present(DIM)) then
100          uDIM = DIM
101       else
102          uDIM = 2
103       end if
104       ASSERT_(uDIM>0 .and. uDIM<3)
105       ASSERT_(size(A)==size(B,uDIM))
106       if(uDIM==1) then
107          call QSORTS(A,B,size(A),-size(B,2))
108       else
109          call QSORTS(A,B,size(A), size(B,1))
110       end if
111
112     end subroutine SORT2S
113
114
115
116     subroutine SORT2DS(B,DIM)
117       integer(kind=4),   intent(INOUT) :: B(:,:)
118       integer, optional, intent(IN   ) :: DIM
119
120       integer :: uDIM
121
122       if(present(DIM)) then
123          uDIM = DIM
124       else
125          uDIM = 2
126       end if
127
128       ASSERT_(uDIM>0 .and. uDIM<3)
129
130       if(uDIM==1) then
131          call QSORTS(B(:,1),B(:,2:),size(B,1),-(size(B,2)-1))
132       else
133          call QSORTS(B(1,:),B(2:,:),size(B,2), (size(B,1)-1))
134       end if
135
136     end subroutine SORT2DS
137
138     subroutine SORT2L(A,B,DIM)
139       integer(kind=8),   intent(INOUT) :: A(:)
140       integer(kind=4),   intent(INOUT) :: B(:,:)
141       integer, optional, intent(IN   ) :: DIM
142
143       integer :: uDIM
144
145       if(present(DIM)) then
146          uDIM = DIM
147       else
148          uDIM = 2
149       end if
150       ASSERT_(uDIM>0 .and. uDIM<3)
151       ASSERT_(size(A)==size(B,uDIM))
152       if(uDIM==1) then
153          call QSORT(A,B,size(A),-size(B,2))
154       else
155          call QSORT(A,B,size(A), size(B,1))
156       end if
157     end subroutine SORT2L
158
159     end module MAPL_SortMod
160     ```