1      SUBROUTINE SORTER(A,N,M,IROW,ICOL,B,IR,IC,IFLAG)
2C
3C  SUBROUTINE TO SORT A TWO DIMENSIONAL INTEGER ARRAY IN ASCENDING ORDER
4C
5C  INPUTS
6C
7C     A    - TWO DIMENSIONAL ARRAY TO BE SORTED
8C     N    - NUMBER OF ROWS IN ARRAY
9C     M    - NUMBER OF COLUMNS IN ARRAY
10C     IROW - IF NON-ZERO, SORT ARRAY BASED ON VALUES IN ROW IROW
11C     ICOL - IF NON-ZERO, SORT ARRAY BASED ON VALUES IN COLUMN ICOL
12C
13C  OUTPUTS
14C
15C     B    - SORTED ARRAY A
16C     IR   - ARRAY ELEMENTS GIVE THE ORDER OF ROWS EXCHANGED
17C     IC   - ARRAY ELEMENTS GIVE THE ORDER OF COLUMNS EXCHANGED
18C     IFLAG- RETURNS A ZERO (0) FOR ARRAY SORTED,  RETURNS A ONE (1)
19C            FOR NO ARRAY SORTING PERFORMED
20C
21C  COMMENTS
22C
23C     IF ICOL AND IROW ARE BOTH NON-ZERO, THE SORTING WILL BE FIRST
24C     PERFORMED BY THE VALUES IN COLUMN ICOL, THEN BY THE VALUES IN
25C     ROW IROW. IF THIS OPTION IS SPECIFIED, THE ORIGINAL MATRIX A
26C     IS DESTROYED.  FOR A VECTOR, SET M TO ONE AND IROW TO ZERO.
27C
28C     THIS ROUTINE IS DESIGNED FOR INTEGER ARRAYS, BUT CAN BE
29C     USED FOR FLOATING POINT ARRAYS AS WELL BY DELETING THE
30C     INTEGER DECLARATION CARD THAT FOLLOWS.
31C
32      INTEGER A,B,BMIN,BMAX
33      DIMENSION A(N,M),B(N,M),IR(N),IC(M)
34      IF(N.LE.0) GO TO 1290
35      IF(M.LE.0) GO TO 1290
36      DO 1000 I=1,N
37 1000 IR(I)=I
38      DO 1010 I=1,M
39 1010 IC(I)=I
40      IF(N.EQ.M.AND.N.LT.2) GO TO 1300
41      IFLAG=0
42      IF(ICOL)1020,1020,1030
43 1020 IF(IROW)1250,1250,1130
44 1030 CONTINUE
45C
46C  SORT ARRAY BY THE VALUES IN COLUMN ICOL (REORDER ROWS)
47C
48      IRR=1
49      KK=1
50      ISTAT=0
51      KOUNT=0
52      DO 1040 I=1,N
53         DO 1040 J=1,M
54 1040 B(I,J)=A(I,J)
55      BMAX=B(1,ICOL)
56      BMIN=BMAX
57 1050 DO 1080 K1=1,N
58         K=N-K1+1
59         IF(ISTAT)1060,1060,1070
60 1060    IF(BMAX.LE.B(K,ICOL))BMAX=B(K,ICOL)
61         IF(BMAX.EQ.B(K,ICOL))KK=K
62         GO TO 1080
63 1070    IF(BMIN.GE.B(K,ICOL))BMIN=B(K,ICOL)
64         IF(BMIN.EQ.B(K,ICOL))KK=K
65 1080 CONTINUE
66      KOUNT=KOUNT+1
67      IF(ISTAT)1090,1090,1100
68 1090 ISTAT=1
69      KOUNT=0
70      KK=1
71      GO TO 1050
72 1100 IF(KOUNT.GE.(N+1))GO TO 1110
73      B(KK,ICOL)=BMAX+BMAX
74      IR(IRR)=KK
75      IRR=IRR+1
76      BMIN=BMAX+BMAX
77      GO TO 1050
78 1110 DO 1120 K=1,N
79         LL=IR(K)
80         DO 1120 L=1,M
81            B(K,L)=A(LL,L)
82 1120 CONTINUE
83      IFLAG=-1
84      GO TO 1020
85 1130 CONTINUE
86C
87C  SORT ARRAY BY THE VALUES IN ROW IROW (REORDER COLUMNS)
88C
89      IF(IFLAG.GE.0)GO TO 1150
90      DO 1140 I=1,N
91         DO 1140 J=1,M
92 1140 A(I,J)=B(I,J)
93 1150 CONTINUE
94      IRR=1
95      KK=1
96      ISTAT=0
97      KOUNT=0
98      DO 1160 I=1,N
99         DO 1160 J=1,M
100 1160 B(I,J)=A(I,J)
101      BMAX=B(IROW,1)
102      BMIN=BMAX
103 1170 DO 1200 K1=1,M
104         K=M-K1+1
105         IF(ISTAT)1180,1180,1190
106 1180    IF(BMAX.LE.B(IROW,K))BMAX=B(IROW,K)
107         IF(BMAX.EQ.B(IROW,K))KK=K
108         GO TO 1200
109 1190    IF(BMIN.GE.B(IROW,K))BMIN=B(IROW,K)
110         IF(BMIN.EQ.B(IROW,K))KK=K
111 1200 CONTINUE
112      KOUNT=KOUNT+1
113      IF(ISTAT)1210,1210,1220
114 1210 ISTAT=1
115      KOUNT=0
116      KK=1
117      GO TO 1170
118 1220 IF(KOUNT.GE.(M+1))GO TO 1230
119      B(IROW,KK)=BMAX+BMAX
120      IC(IRR)=KK
121      IRR=IRR+1
122      BMIN=BMAX+BMAX
123      GO TO 1170
124 1230 DO 1240 L=1,M
125         LL=IC(L)
126         DO 1240 K=1,N
127            B(K,L)=A(K,LL)
128 1240 CONTINUE
129 1250 IFLAG=0
130      DO 1260 I=1,N
131         IF(IR(I).NE.I) GO TO 1300
132 1260 CONTINUE
133 1270 DO 1280 I=1,M
134         IF(IC(I).NE.I) GO TO 1300
135 1280 CONTINUE
136 1290 IFLAG=1
137 1300 CONTINUE
138      RETURN
139      END
140