00001 SUBROUTINE SLAMRG( N1, N2, A, STRD1, STRD2, INDEX ) 00002 * 00003 * -- LAPACK routine (version 3.2) -- 00004 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00005 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00006 * November 2006 00007 * 00008 * .. Scalar Arguments .. 00009 INTEGER N1, N2, STRD1, STRD2 00010 * .. 00011 * .. Array Arguments .. 00012 INTEGER INDEX( * ) 00013 REAL A( * ) 00014 * .. 00015 * 00016 * Purpose 00017 * ======= 00018 * 00019 * SLAMRG will create a permutation list which will merge the elements 00020 * of A (which is composed of two independently sorted sets) into a 00021 * single set which is sorted in ascending order. 00022 * 00023 * Arguments 00024 * ========= 00025 * 00026 * N1 (input) INTEGER 00027 * N2 (input) INTEGER 00028 * These arguements contain the respective lengths of the two 00029 * sorted lists to be merged. 00030 * 00031 * A (input) REAL array, dimension (N1+N2) 00032 * The first N1 elements of A contain a list of numbers which 00033 * are sorted in either ascending or descending order. Likewise 00034 * for the final N2 elements. 00035 * 00036 * STRD1 (input) INTEGER 00037 * STRD2 (input) INTEGER 00038 * These are the strides to be taken through the array A. 00039 * Allowable strides are 1 and -1. They indicate whether a 00040 * subset of A is sorted in ascending (STRDx = 1) or descending 00041 * (STRDx = -1) order. 00042 * 00043 * INDEX (output) INTEGER array, dimension (N1+N2) 00044 * On exit this array will contain a permutation such that 00045 * if B( I ) = A( INDEX( I ) ) for I=1,N1+N2, then B will be 00046 * sorted in ascending order. 00047 * 00048 * ===================================================================== 00049 * 00050 * .. Local Scalars .. 00051 INTEGER I, IND1, IND2, N1SV, N2SV 00052 * .. 00053 * .. Executable Statements .. 00054 * 00055 N1SV = N1 00056 N2SV = N2 00057 IF( STRD1.GT.0 ) THEN 00058 IND1 = 1 00059 ELSE 00060 IND1 = N1 00061 END IF 00062 IF( STRD2.GT.0 ) THEN 00063 IND2 = 1 + N1 00064 ELSE 00065 IND2 = N1 + N2 00066 END IF 00067 I = 1 00068 * while ( (N1SV > 0) & (N2SV > 0) ) 00069 10 CONTINUE 00070 IF( N1SV.GT.0 .AND. N2SV.GT.0 ) THEN 00071 IF( A( IND1 ).LE.A( IND2 ) ) THEN 00072 INDEX( I ) = IND1 00073 I = I + 1 00074 IND1 = IND1 + STRD1 00075 N1SV = N1SV - 1 00076 ELSE 00077 INDEX( I ) = IND2 00078 I = I + 1 00079 IND2 = IND2 + STRD2 00080 N2SV = N2SV - 1 00081 END IF 00082 GO TO 10 00083 END IF 00084 * end while 00085 IF( N1SV.EQ.0 ) THEN 00086 DO 20 N1SV = 1, N2SV 00087 INDEX( I ) = IND2 00088 I = I + 1 00089 IND2 = IND2 + STRD2 00090 20 CONTINUE 00091 ELSE 00092 * N2SV .EQ. 0 00093 DO 30 N2SV = 1, N1SV 00094 INDEX( I ) = IND1 00095 I = I + 1 00096 IND1 = IND1 + STRD1 00097 30 CONTINUE 00098 END IF 00099 * 00100 RETURN 00101 * 00102 * End of SLAMRG 00103 * 00104 END
1.7.2