*DECK MC20AD
      SUBROUTINE MC20AD (NC, MAXA, A, INUM, JPTR, JNUM, JDISP)
C***BEGIN PROLOGUE  MC20AD
C***SUBSIDIARY
C***PURPOSE  Subsidiary to DSPLP
C***LIBRARY   SLATEC
C***TYPE      DOUBLE PRECISION (MC20AS-S, MC20AD-D)
C***AUTHOR  (UNKNOWN)
C***DESCRIPTION
C
C     THIS SUBPROGRAM IS A SLIGHT MODIFICATION OF A SUBPROGRAM
C     FROM THE C. 1979 AERE HARWELL LIBRARY.  THE NAME OF THE
C     CORRESPONDING HARWELL CODE CAN BE OBTAINED BY DELETING
C     THE FINAL LETTER =D= IN THE NAMES USED HERE.
C     REVISED SEP. 13, 1979.
C
C     ROYALTIES HAVE BEEN PAID TO AERE-UK FOR USE OF THEIR CODES
C     IN THE PACKAGE GIVEN HERE.  ANY PRIMARY USAGE OF THE HARWELL
C     SUBROUTINES REQUIRES A ROYALTY AGREEMENT AND PAYMENT BETWEEN
C     THE USER AND AERE-UK.  ANY USAGE OF THE SANDIA WRITTEN CODES
C     DSPLP( ) (WHICH USES THE HARWELL SUBROUTINES) IS PERMITTED.
C
C***SEE ALSO  DSPLP
C***ROUTINES CALLED  (NONE)
C***REVISION HISTORY  (YYMMDD)
C   811215  DATE WRITTEN
C   890831  Modified array declarations.  (WRB)
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   900402  Added TYPE section.  (WRB)
C***END PROLOGUE  MC20AD
      INTEGER INUM(*), JNUM(*)
      DOUBLE PRECISION A(*),ACE,ACEP
      DIMENSION JPTR(NC)
C***FIRST EXECUTABLE STATEMENT  MC20AD
      NULL = -JDISP
C**      CLEAR JPTR
      DO 10 J=1,NC
         JPTR(J) = 0
   10 CONTINUE
C**      COUNT THE NUMBER OF ELEMENTS IN EACH COLUMN.
      DO 20 K=1,MAXA
         J = JNUM(K) + JDISP
         JPTR(J) = JPTR(J) + 1
   20 CONTINUE
C**      SET THE JPTR ARRAY
      K = 1
      DO 30 J=1,NC
         KR = K + JPTR(J)
         JPTR(J) = K
         K = KR
   30 CONTINUE
C
C**      REORDER THE ELEMENTS INTO COLUMN ORDER.  THE ALGORITHM IS AN
C        IN-PLACE SORT AND IS OF ORDER MAXA.
      DO 50 I=1,MAXA
C        ESTABLISH THE CURRENT ENTRY.
         JCE = JNUM(I) + JDISP
         IF (JCE.EQ.0) GO TO 50
         ACE = A(I)
         ICE = INUM(I)
C        CLEAR THE LOCATION VACATED.
         JNUM(I) = NULL
C        CHAIN FROM CURRENT ENTRY TO STORE ITEMS.
         DO 40 J=1,MAXA
C        CURRENT ENTRY NOT IN CORRECT POSITION.  DETERMINE CORRECT
C        POSITION TO STORE ENTRY.
            LOC = JPTR(JCE)
            JPTR(JCE) = JPTR(JCE) + 1
C        SAVE CONTENTS OF THAT LOCATION.
            ACEP = A(LOC)
            ICEP = INUM(LOC)
            JCEP = JNUM(LOC)
C        STORE CURRENT ENTRY.
            A(LOC) = ACE
            INUM(LOC) = ICE
            JNUM(LOC) = NULL
C        CHECK IF NEXT CURRENT ENTRY NEEDS TO BE PROCESSED.
            IF (JCEP.EQ.NULL) GO TO 50
C        IT DOES.  COPY INTO CURRENT ENTRY.
            ACE = ACEP
            ICE = ICEP
            JCE = JCEP + JDISP
   40    CONTINUE
C
   50 CONTINUE
C
C**      RESET JPTR VECTOR.
      JA = 1
      DO 60 J=1,NC
         JB = JPTR(J)
         JPTR(J) = JA
         JA = JB
   60 CONTINUE
      RETURN
      END
