1      SUBROUTINE MC20AS(NC, MAXA, A, INUM, JPTR, JNUM, JDISP)
2C***BEGIN PROLOGUE  MC20AS
3C***REFER TO  SPLP
4C     THIS SUBPROGRAM IS A SLIGHT MODIFICATION OF A SUBPROGRAM
5C     FROM THE C. 1979 AERE HARWELL LIBRARY.  THE NAME OF THE
6C     CORRESPONDING HARWELL CODE CAN BE OBTAINED BY DELETING
7C     THE FINAL LETTER =S= IN THE NAMES USED HERE.
8C     REVISED SEP. 13, 1979.
9C
10C     ROYALTIES HAVE BEEN PAID TO AERE-UK FOR USE OF THEIR CODES
11C     IN THE PACKAGE GIVEN HERE.  ANY PRIMARY USAGE OF THE HARWELL
12C     SUBROUTINES REQUIRES A ROYALTY AGREEMENT AND PAYMENT BETWEEN
13C     THE USER AND AERE-UK.  ANY USAGE OF THE SANDIA WRITTEN CODES
14C     SPLP( ) (WHICH USES THE HARWELL SUBROUTINES) IS PERMITTED.
15C***ROUTINES CALLED  (NONE)
16C***END PROLOGUE  MC20AS
17      INTEGER INUM(MAXA), JNUM(MAXA)
18      REAL A(MAXA)
19      DIMENSION JPTR(NC)
20C***FIRST EXECUTABLE STATEMENT  MC20AS
21      NULL = -JDISP
22C**      CLEAR JPTR
23      DO 10 J=1,NC
24         JPTR(J) = 0
25   10 CONTINUE
26C**      COUNT THE NUMBER OF ELEMENTS IN EACH COLUMN.
27      DO 20 K=1,MAXA
28         J = JNUM(K) + JDISP
29         JPTR(J) = JPTR(J) + 1
30   20 CONTINUE
31C**      SET THE JPTR ARRAY
32      K = 1
33      DO 30 J=1,NC
34         KR = K + JPTR(J)
35         JPTR(J) = K
36         K = KR
37   30 CONTINUE
38C
39C**      REORDER THE ELEMENTS INTO COLUMN ORDER.  THE ALGORITHM IS AN
40C        IN-PLACE SORT AND IS OF ORDER MAXA.
41      DO 50 I=1,MAXA
42C        ESTABLISH THE CURRENT ENTRY.
43         JCE = JNUM(I) + JDISP
44         IF (JCE.EQ.0) GO TO 50
45         ACE = A(I)
46         ICE = INUM(I)
47C        CLEAR THE LOCATION VACATED.
48         JNUM(I) = NULL
49C        CHAIN FROM CURRENT ENTRY TO STORE ITEMS.
50         DO 40 J=1,MAXA
51C        CURRENT ENTRY NOT IN CORRECT POSITION.  DETERMINE CORRECT
52C        POSITION TO STORE ENTRY.
53            LOC = JPTR(JCE)
54            JPTR(JCE) = JPTR(JCE) + 1
55C        SAVE CONTENTS OF THAT LOCATION.
56            ACEP = A(LOC)
57            ICEP = INUM(LOC)
58            JCEP = JNUM(LOC)
59C        STORE CURRENT ENTRY.
60            A(LOC) = ACE
61            INUM(LOC) = ICE
62            JNUM(LOC) = NULL
63C        CHECK IF NEXT CURRENT ENTRY NEEDS TO BE PROCESSED.
64            IF (JCEP.EQ.NULL) GO TO 50
65C        IT DOES.  COPY INTO CURRENT ENTRY.
66            ACE = ACEP
67            ICE = ICEP
68            JCE = JCEP + JDISP
69   40    CONTINUE
70C
71   50 CONTINUE
72C
73C**      RESET JPTR VECTOR.
74      JA = 1
75      DO 60 J=1,NC
76         JB = JPTR(J)
77         JPTR(J) = JA
78         JA = JB
79   60 CONTINUE
80      RETURN
81      END
82