CTITLEUSDMERG -- Merge two sorted double-word arrays                    00010000
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CA    AUTHOR       S. Nelan                                             00020000
CA    DESIGNER     S. Nelan                                             00030000
CA    LANGUAGE     FORTRAN                                              00040000
CA    SYSTEM       IBM ONLY                                             00050000
CA    WRITTEN      10-01-91                                             00060000
C     REVISED      mm-dd-yy BY iii.  ...                                00070000
CA                                                                      00080000
CA                                                                      00090000
CA    CALL USDMERG (NEL, NWPE, KEY, ARRAY, UPDOWN)                      00100000
CA                                                                      00110000
CA    IN/OUT  ARGUMENT  TYPE  DESCRIPTION                               00120000
CA                                                                      00130000
CA      IN     ARRAY1    R8   First sorted input array (length NEL1).   00140000
CA      IN     NEL1      I4   Number of elements in ARRAY1.             00150000
CA      IN     ARRAY2    R8   Second sorted input array (length NEL2).  00160000
CA      IN     NEL2      I4   Number of elements in ARRAY2.             00170000
CA      OUT    ARRAY3    R8   Output merged array (length NEL1+NEL2)    00180000
CA                                                                      00190000
CA                                                                      00200000
CA    This subroutine merges two sorted double-word arrays into a       00210000
CA    single array of ascending order.                                  00220000
CAEND                                                                   00230000
C     EJECT                                                             00240000
      SUBROUTINE USDMERG (ARRAY1, NEL1, ARRAY2, NEL2, ARRAY3)           00250000
C                                                                       00260000
      IMPLICIT INTEGER (A-Z)                                            00270000
C                                                                       00280000
      DOUBLE PRECISION ARRAY1(*)                                        00290000
      DOUBLE PRECISION ARRAY2(*)                                        00300000
      DOUBLE PRECISION ARRAY3(*)                                        00310000
C                                                                       00320000
c     write (6,9000) nel1,nel2                                          00330000
c9000 format (5x,'nel1,nel2 =',2i10)                                    00340000
c     write (6,9001) (array1(i),i=1,nel1)                               00350000
c9001 format (5x,5z20)                                                  00360000
c     write (6,9001) (array2(i),i=1,nel2)                               00370000
C                                                                       00380000
C                 Start off by checking the arrays ...                  00390000
C                 if only one has data move and exit                    00400000
C                                                                       00410000
      INDX1 = 1                                                         00420000
      INDX2 = 1                                                         00430000
      INDX3 = 1                                                         00440000
      IF (INDX1 .LE. NEL1) THEN                                         00450000
          IF (INDX2 .LE. NEL2) THEN                                     00460000
              GO TO                                                100  00470000
          ELSE                                                          00480000
              CALL ARMVE (ARRAY1(INDX1), ARRAY3(INDX3),                 00490000
     *                    2*(NEL1-INDX1+1))                             00500000
          ENDIF                                                         00510000
      ELSE                                                              00520000
          IF (INDX2 .LE. NEL2) THEN                                     00530000
              CALL ARMVE (ARRAY2(INDX2), ARRAY3(INDX3),                 00540000
     *                    2*(NEL2-INDX2+1))                             00550000
          ENDIF                                                         00560000
      ENDIF                                                             00570000
      GO TO                                                        200  00580000
C                                                                       00590000
C                 Main loop to check and merge                          00600000
C                                                                       00610000
  100 CONTINUE                                                          00620000
      IF (ARRAY1(INDX1) .LE. ARRAY2(INDX2)) THEN                        00630000
          ARRAY3(INDX3) = ARRAY1(INDX1)                                 00640000
          INDX1 = INDX1 + 1                                             00650000
      ELSE                                                              00660000
          ARRAY3(INDX3) = ARRAY2(INDX2)                                 00670000
          INDX2 = INDX2 + 1                                             00680000
      ENDIF                                                             00690000
      INDX3 = INDX3 + 1                                                 00700000
      IF (INDX1 .LE. NEL1) THEN                                         00710000
          IF (INDX2 .LE. NEL2) THEN                                     00720000
              GO TO                                                100  00730000
          ELSE                                                          00740000
              CALL ARMVE (ARRAY1(INDX1), ARRAY3(INDX3),                 00750000
     *                    2*(NEL1-INDX1+1))                             00760000
          ENDIF                                                         00770000
      ELSE                                                              00780000
          IF (INDX2 .LE. NEL2) THEN                                     00790000
              CALL ARMVE (ARRAY2(INDX2), ARRAY3(INDX3),                 00800000
     *                    2*(NEL2-INDX2+1))                             00810000
          ENDIF                                                         00820000
      ENDIF                                                             00830000
  200 CONTINUE                                                          00840000
c     write (6,9001) (array3(i),i=1,nel1+nel2)                          00850000
      RETURN                                                            00860000
C                                                                       00870000
      END                                                               00880000