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.

rotg.c 2.3 kB

2 years ago
2 years ago
2 years ago
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
  1. #include <math.h>
  2. #include <float.h>
  3. #include "common.h"
  4. #ifdef FUNCTION_PROFILE
  5. #include "functable.h"
  6. #endif
  7. #ifndef CBLAS
  8. void NAME(FLOAT *DA, FLOAT *DB, FLOAT *C, FLOAT *S){
  9. #else
  10. void CNAME(FLOAT *DA, FLOAT *DB, FLOAT *C, FLOAT *S){
  11. #endif
  12. #ifdef DOUBLE
  13. long double safmin = DBL_MIN;
  14. #else
  15. long double safmin = FLT_MIN;
  16. #endif
  17. #if defined(__i386__) || defined(__x86_64__) || defined(__ia64__) || defined(_M_X64) || defined(_M_IX86)
  18. long double da = *DA;
  19. long double db = *DB;
  20. long double c;
  21. long double s;
  22. long double r, z;
  23. long double sigma, dascal,dbscal;
  24. long double ada = fabsl(da);
  25. long double adb = fabsl(db);
  26. long double maxab = MAX(ada,adb);
  27. long double safmax;
  28. long double scale;
  29. #ifndef CBLAS
  30. PRINT_DEBUG_NAME;
  31. #else
  32. PRINT_DEBUG_CNAME;
  33. #endif
  34. if (adb == ZERO) {
  35. *C = ONE;
  36. *S = ZERO;
  37. *DB = ZERO;
  38. } else if (ada == ZERO) {
  39. *C = ZERO;
  40. *S = ONE;
  41. *DA = *DB;
  42. *DB = ONE;
  43. } else {
  44. safmax = 1./safmin;
  45. scale = MIN(MAX(safmin,maxab), safmax);
  46. if (ada > adb)
  47. sigma = copysign(1.,da);
  48. else
  49. sigma = copysign(1.,db);
  50. dascal = da / scale;
  51. dbscal = db / scale;
  52. r = sigma * (scale * sqrt(dascal * dascal + dbscal * dbscal));
  53. c = da / r;
  54. s = db / r;
  55. z = ONE;
  56. if (da != ZERO) {
  57. if (ada > adb){
  58. z = s;
  59. } else {
  60. z = ONE / c;
  61. }
  62. }
  63. *C = c;
  64. *S = s;
  65. *DA = r;
  66. *DB = z;
  67. }
  68. #else
  69. FLOAT da = *DA;
  70. FLOAT db = *DB;
  71. FLOAT c = *C;
  72. FLOAT s = *S;
  73. FLOAT sigma;
  74. FLOAT r, z;
  75. FLOAT ada = fabs(da);
  76. FLOAT adb = fabs(db);
  77. FLOAT maxab = MAX(ada,adb);
  78. long double safmax ;
  79. FLOAT scale ;
  80. safmax = 1./safmin;
  81. scale = MIN(MAX(safmin,maxab), safmax);
  82. if (ada > adb)
  83. sigma = copysign(1.,da);
  84. else
  85. sigma = copysign(1.,db);
  86. #ifndef CBLAS
  87. PRINT_DEBUG_NAME;
  88. #else
  89. PRINT_DEBUG_CNAME;
  90. #endif
  91. if (adb == ZERO) {
  92. *C = ONE;
  93. *S = ZERO;
  94. *DB = ZERO;
  95. } else if (ada == ZERO) {
  96. *C = ZERO;
  97. *S = ONE;
  98. *DA = *DB;
  99. *DB = ONE;
  100. } else {
  101. FLOAT aa = da / scale;
  102. FLOAT bb = db / scale;
  103. r = sigma * scale * sqrt(aa * aa + bb * bb);
  104. c = da / r;
  105. s = db / r;
  106. z = ONE;
  107. if (ada > adb) z = s;
  108. if ((ada <= adb) && (c != ZERO)) z = ONE / c;
  109. *C = c;
  110. *S = s;
  111. *DA = r;
  112. *DB = z;
  113. }
  114. #endif
  115. return;
  116. }