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