C                                                                       00001002
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CTITLESAEQMOC -- REORDER A INTO B IN ASCENDING ORDER                    00002003
CA                                                                      00003002
CA   DESIGNER     PETER LUH                                             00004004
CA   AUTHOR       PETER LUH                                             00005004
CA   LANGUAGE     FORTRAN 77                                            00006002
CA   SYSTEM       IBM / CRAY                                            00007004
CA   WRITTEN      11/16/90                                              00008004
C    REVISED      02/12/92  JJC - MODIFIED TO MEET EDP STANDARDS.       00009004
C                                 RENAMED DBLMED TO SAEQMOC.
C                                 FOR CRAY CONVERSION.
CA                                                                      00009102
CA                                                                      00110002
CA CALLING PROCEDURE:                                                   00120002
CA     SUBROUTINE SAEQMOC(N, A, B, D1, D2)                              00130004
CA                                                                      00140002
C   CALLING ARGUMENTS                                                   00150002
CA                                                                      00160002
CA     IN       N     NUMBER OF ELEMENTS                            I4  00170005
CA     IN       A     INPUT ARRAY                                   R4  00180005
CA     OUT      B     OUTPUT ARRAY                                  R4  00190005
CA     OUT      D1    MEDIAN VALUE                                  R4  00200005
CA                                                                      00009702
      SUBROUTINE SAEQMOC(N,A,B,D1,D2)                                   00010000
C                                                                       00060001
      IMPLICIT INTEGER (A-Z)                                            00070001
C                                                                       00080001
      DIMENSION A(*),B(*)                                               00090000
C                                                                       00100001
      REAL    A                                                         00110001
      REAL    B                                                         00120001
      REAL    D1                                                        00130001
      REAL    D2                                                        00140001
      REAL    Q                                                         00150001
      REAL    X                                                         00160001
      REAL    YK                                                        00170001
C                                                                       00180001
C                                                                       00190001
      DO 100 I = 1, N
         B(I) = A(I)
 100  CONTINUE
      D1 = A(1)
      IF (N - 2 .GT. 0) GO TO 140
      IF (N - 2 .EQ. 0) GO TO 120
      D2 = A(1)
      RETURN
 120  CONTINUE
      D2 = A(2)
      RETURN
 140  CONTINUE
      M2 = N / 2
      NP = (N + 1 )  / 2
      IS = MOD ( N, 2 )  + 1
      NNP = N
      DO 180 I = 1, M2
         X = B(I)
         YK = B(I)
         KX = I
         KN = I
         K = I + 1
         DO 160 L = K, NNP
            IF (B(L) .GE. X) THEN
               X = B(L)
               KX = L
            ENDIF
            IF (YK .GT. B(L)) THEN
               YK = B(L)
               KN = L
            ENDIF
 160     CONTINUE
         Q = B(I)
         B(I) = YK
         B(KN) = Q
         IF (KX .EQ. I) KX = KN
         Q = B(NNP)
         B(NNP) = X
         B(KX) = Q
         NNP = NNP - 1
 180  CONTINUE
      D1 = B(NP)
      GO TO (200,220 ) IS
 200  CONTINUE
      D2 = B(NP + 1)
      RETURN
 220  CONTINUE
      D2 = B(NP)
C
      RETURN
      END