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