You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.

rotm.c 2.7 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155
  1. #include "common.h"
  2. #ifdef FUNCTION_PROFILE
  3. #include "functable.h"
  4. #endif
  5. #ifndef CBLAS
  6. void NAME(blasint *N, FLOAT *dx, blasint *INCX, FLOAT *dy, blasint *INCY, FLOAT *dparam){
  7. blasint n = *N;
  8. blasint incx = *INCX;
  9. blasint incy = *INCY;
  10. #else
  11. void CNAME(blasint n, FLOAT *dx, blasint incx, FLOAT *dy, blasint incy, FLOAT *dparam){
  12. #endif
  13. blasint i__1, i__2;
  14. blasint i__;
  15. FLOAT w, z__;
  16. blasint kx, ky;
  17. FLOAT dh11, dh12, dh22, dh21, dflag;
  18. blasint nsteps;
  19. #ifndef CBLAS
  20. PRINT_DEBUG_CNAME;
  21. #else
  22. PRINT_DEBUG_CNAME;
  23. #endif
  24. --dparam;
  25. --dy;
  26. --dx;
  27. dflag = dparam[1];
  28. if (n <= 0 || dflag == - 2.0) goto L140;
  29. if (! (incx == incy && incx > 0)) goto L70;
  30. nsteps = n * incx;
  31. if (dflag < 0.) {
  32. goto L50;
  33. } else if (dflag == 0) {
  34. goto L10;
  35. } else {
  36. goto L30;
  37. }
  38. L10:
  39. dh12 = dparam[4];
  40. dh21 = dparam[3];
  41. i__1 = nsteps;
  42. i__2 = incx;
  43. for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
  44. w = dx[i__];
  45. z__ = dy[i__];
  46. dx[i__] = w + z__ * dh12;
  47. dy[i__] = w * dh21 + z__;
  48. /* L20: */
  49. }
  50. goto L140;
  51. L30:
  52. dh11 = dparam[2];
  53. dh22 = dparam[5];
  54. i__2 = nsteps;
  55. i__1 = incx;
  56. for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) {
  57. w = dx[i__];
  58. z__ = dy[i__];
  59. dx[i__] = w * dh11 + z__;
  60. dy[i__] = -w + dh22 * z__;
  61. /* L40: */
  62. }
  63. goto L140;
  64. L50:
  65. dh11 = dparam[2];
  66. dh12 = dparam[4];
  67. dh21 = dparam[3];
  68. dh22 = dparam[5];
  69. i__1 = nsteps;
  70. i__2 = incx;
  71. for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
  72. w = dx[i__];
  73. z__ = dy[i__];
  74. dx[i__] = w * dh11 + z__ * dh12;
  75. dy[i__] = w * dh21 + z__ * dh22;
  76. /* L60: */
  77. }
  78. goto L140;
  79. L70:
  80. kx = 1;
  81. ky = 1;
  82. if (incx < 0) {
  83. kx = (1 - n) * incx + 1;
  84. }
  85. if (incy < 0) {
  86. ky = (1 - n) * incy + 1;
  87. }
  88. if (dflag < 0.) {
  89. goto L120;
  90. } else if (dflag == 0) {
  91. goto L80;
  92. } else {
  93. goto L100;
  94. }
  95. L80:
  96. dh12 = dparam[4];
  97. dh21 = dparam[3];
  98. i__2 = n;
  99. for (i__ = 1; i__ <= i__2; ++i__) {
  100. w = dx[kx];
  101. z__ = dy[ky];
  102. dx[kx] = w + z__ * dh12;
  103. dy[ky] = w * dh21 + z__;
  104. kx += incx;
  105. ky += incy;
  106. /* L90: */
  107. }
  108. goto L140;
  109. L100:
  110. dh11 = dparam[2];
  111. dh22 = dparam[5];
  112. i__2 = n;
  113. for (i__ = 1; i__ <= i__2; ++i__) {
  114. w = dx[kx];
  115. z__ = dy[ky];
  116. dx[kx] = w * dh11 + z__;
  117. dy[ky] = -w + dh22 * z__;
  118. kx += incx;
  119. ky += incy;
  120. /* L110: */
  121. }
  122. goto L140;
  123. L120:
  124. dh11 = dparam[2];
  125. dh12 = dparam[4];
  126. dh21 = dparam[3];
  127. dh22 = dparam[5];
  128. i__2 = n;
  129. for (i__ = 1; i__ <= i__2; ++i__) {
  130. w = dx[kx];
  131. z__ = dy[ky];
  132. dx[kx] = w * dh11 + z__ * dh12;
  133. dy[ky] = w * dh21 + z__ * dh22;
  134. kx += incx;
  135. ky += incy;
  136. /* L130: */
  137. }
  138. L140:
  139. return;
  140. }