dlamrg.c 3.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132
  1. /* dlamrg.f -- translated by f2c (version 20061008).
  2. You must link the resulting object file with libf2c:
  3. on Microsoft Windows system, link with libf2c.lib;
  4. on Linux or Unix systems, link with .../path/to/libf2c.a -lm
  5. or, if you install libf2c.a in a standard place, with -lf2c -lm
  6. -- in that order, at the end of the command line, as in
  7. cc *.o -lf2c -lm
  8. Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
  9. http://www.netlib.org/f2c/libf2c.zip
  10. */
  11. #include "f2c.h"
  12. #include "blaswrap.h"
  13. /* Subroutine */ int dlamrg_(integer *n1, integer *n2, doublereal *a, integer
  14. *dtrd1, integer *dtrd2, integer *index)
  15. {
  16. /* System generated locals */
  17. integer i__1;
  18. /* Local variables */
  19. integer i__, ind1, ind2, n1sv, n2sv;
  20. /* -- LAPACK routine (version 3.2) -- */
  21. /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  22. /* November 2006 */
  23. /* .. Scalar Arguments .. */
  24. /* .. */
  25. /* .. Array Arguments .. */
  26. /* .. */
  27. /* Purpose */
  28. /* ======= */
  29. /* DLAMRG will create a permutation list which will merge the elements */
  30. /* of A (which is composed of two independently sorted sets) into a */
  31. /* single set which is sorted in ascending order. */
  32. /* Arguments */
  33. /* ========= */
  34. /* N1 (input) INTEGER */
  35. /* N2 (input) INTEGER */
  36. /* These arguements contain the respective lengths of the two */
  37. /* sorted lists to be merged. */
  38. /* A (input) DOUBLE PRECISION array, dimension (N1+N2) */
  39. /* The first N1 elements of A contain a list of numbers which */
  40. /* are sorted in either ascending or descending order. Likewise */
  41. /* for the final N2 elements. */
  42. /* DTRD1 (input) INTEGER */
  43. /* DTRD2 (input) INTEGER */
  44. /* These are the strides to be taken through the array A. */
  45. /* Allowable strides are 1 and -1. They indicate whether a */
  46. /* subset of A is sorted in ascending (DTRDx = 1) or descending */
  47. /* (DTRDx = -1) order. */
  48. /* INDEX (output) INTEGER array, dimension (N1+N2) */
  49. /* On exit this array will contain a permutation such that */
  50. /* if B( I ) = A( INDEX( I ) ) for I=1,N1+N2, then B will be */
  51. /* sorted in ascending order. */
  52. /* ===================================================================== */
  53. /* .. Local Scalars .. */
  54. /* .. */
  55. /* .. Executable Statements .. */
  56. /* Parameter adjustments */
  57. --index;
  58. --a;
  59. /* Function Body */
  60. n1sv = *n1;
  61. n2sv = *n2;
  62. if (*dtrd1 > 0) {
  63. ind1 = 1;
  64. } else {
  65. ind1 = *n1;
  66. }
  67. if (*dtrd2 > 0) {
  68. ind2 = *n1 + 1;
  69. } else {
  70. ind2 = *n1 + *n2;
  71. }
  72. i__ = 1;
  73. /* while ( (N1SV > 0) & (N2SV > 0) ) */
  74. L10:
  75. if (n1sv > 0 && n2sv > 0) {
  76. if (a[ind1] <= a[ind2]) {
  77. index[i__] = ind1;
  78. ++i__;
  79. ind1 += *dtrd1;
  80. --n1sv;
  81. } else {
  82. index[i__] = ind2;
  83. ++i__;
  84. ind2 += *dtrd2;
  85. --n2sv;
  86. }
  87. goto L10;
  88. }
  89. /* end while */
  90. if (n1sv == 0) {
  91. i__1 = n2sv;
  92. for (n1sv = 1; n1sv <= i__1; ++n1sv) {
  93. index[i__] = ind2;
  94. ++i__;
  95. ind2 += *dtrd2;
  96. /* L20: */
  97. }
  98. } else {
  99. /* N2SV .EQ. 0 */
  100. i__1 = n1sv;
  101. for (n2sv = 1; n2sv <= i__1; ++n2sv) {
  102. index[i__] = ind1;
  103. ++i__;
  104. ind1 += *dtrd1;
  105. /* L30: */
  106. }
  107. }
  108. return 0;
  109. /* End of DLAMRG */
  110. } /* dlamrg_ */