dlansf.c 28 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013
  1. /* dlansf.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. /* Table of constant values */
  14. static integer c__1 = 1;
  15. doublereal _starpu_dlansf_(char *norm, char *transr, char *uplo, integer *n,
  16. doublereal *a, doublereal *work)
  17. {
  18. /* System generated locals */
  19. integer i__1, i__2;
  20. doublereal ret_val, d__1, d__2, d__3;
  21. /* Builtin functions */
  22. double sqrt(doublereal);
  23. /* Local variables */
  24. integer i__, j, k, l;
  25. doublereal s;
  26. integer n1;
  27. doublereal aa;
  28. integer lda, ifm, noe, ilu;
  29. doublereal scale;
  30. extern logical _starpu_lsame_(char *, char *);
  31. doublereal value;
  32. extern integer _starpu_idamax_(integer *, doublereal *, integer *);
  33. extern /* Subroutine */ int _starpu_dlassq_(integer *, doublereal *, integer *,
  34. doublereal *, doublereal *);
  35. /* -- LAPACK routine (version 3.2) -- */
  36. /* -- Contributed by Fred Gustavson of the IBM Watson Research Center -- */
  37. /* -- November 2008 -- */
  38. /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
  39. /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
  40. /* .. Scalar Arguments .. */
  41. /* .. */
  42. /* .. Array Arguments .. */
  43. /* .. */
  44. /* Purpose */
  45. /* ======= */
  46. /* DLANSF returns the value of the one norm, or the Frobenius norm, or */
  47. /* the infinity norm, or the element of largest absolute value of a */
  48. /* real symmetric matrix A in RFP format. */
  49. /* Description */
  50. /* =========== */
  51. /* DLANSF returns the value */
  52. /* DLANSF = ( max(abs(A(i,j))), NORM = 'M' or 'm' */
  53. /* ( */
  54. /* ( norm1(A), NORM = '1', 'O' or 'o' */
  55. /* ( */
  56. /* ( normI(A), NORM = 'I' or 'i' */
  57. /* ( */
  58. /* ( normF(A), NORM = 'F', 'f', 'E' or 'e' */
  59. /* where norm1 denotes the one norm of a matrix (maximum column sum), */
  60. /* normI denotes the infinity norm of a matrix (maximum row sum) and */
  61. /* normF denotes the Frobenius norm of a matrix (square root of sum of */
  62. /* squares). Note that max(abs(A(i,j))) is not a matrix norm. */
  63. /* Arguments */
  64. /* ========= */
  65. /* NORM (input) CHARACTER */
  66. /* Specifies the value to be returned in DLANSF as described */
  67. /* above. */
  68. /* TRANSR (input) CHARACTER */
  69. /* Specifies whether the RFP format of A is normal or */
  70. /* transposed format. */
  71. /* = 'N': RFP format is Normal; */
  72. /* = 'T': RFP format is Transpose. */
  73. /* UPLO (input) CHARACTER */
  74. /* On entry, UPLO specifies whether the RFP matrix A came from */
  75. /* an upper or lower triangular matrix as follows: */
  76. /* = 'U': RFP A came from an upper triangular matrix; */
  77. /* = 'L': RFP A came from a lower triangular matrix. */
  78. /* N (input) INTEGER */
  79. /* The order of the matrix A. N >= 0. When N = 0, DLANSF is */
  80. /* set to zero. */
  81. /* A (input) DOUBLE PRECISION array, dimension ( N*(N+1)/2 ); */
  82. /* On entry, the upper (if UPLO = 'U') or lower (if UPLO = 'L') */
  83. /* part of the symmetric matrix A stored in RFP format. See the */
  84. /* "Notes" below for more details. */
  85. /* Unchanged on exit. */
  86. /* WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)), */
  87. /* where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise, */
  88. /* WORK is not referenced. */
  89. /* Notes */
  90. /* ===== */
  91. /* We first consider Rectangular Full Packed (RFP) Format when N is */
  92. /* even. We give an example where N = 6. */
  93. /* AP is Upper AP is Lower */
  94. /* 00 01 02 03 04 05 00 */
  95. /* 11 12 13 14 15 10 11 */
  96. /* 22 23 24 25 20 21 22 */
  97. /* 33 34 35 30 31 32 33 */
  98. /* 44 45 40 41 42 43 44 */
  99. /* 55 50 51 52 53 54 55 */
  100. /* Let TRANSR = 'N'. RFP holds AP as follows: */
  101. /* For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last */
  102. /* three columns of AP upper. The lower triangle A(4:6,0:2) consists of */
  103. /* the transpose of the first three columns of AP upper. */
  104. /* For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first */
  105. /* three columns of AP lower. The upper triangle A(0:2,0:2) consists of */
  106. /* the transpose of the last three columns of AP lower. */
  107. /* This covers the case N even and TRANSR = 'N'. */
  108. /* RFP A RFP A */
  109. /* 03 04 05 33 43 53 */
  110. /* 13 14 15 00 44 54 */
  111. /* 23 24 25 10 11 55 */
  112. /* 33 34 35 20 21 22 */
  113. /* 00 44 45 30 31 32 */
  114. /* 01 11 55 40 41 42 */
  115. /* 02 12 22 50 51 52 */
  116. /* Now let TRANSR = 'T'. RFP A in both UPLO cases is just the */
  117. /* transpose of RFP A above. One therefore gets: */
  118. /* RFP A RFP A */
  119. /* 03 13 23 33 00 01 02 33 00 10 20 30 40 50 */
  120. /* 04 14 24 34 44 11 12 43 44 11 21 31 41 51 */
  121. /* 05 15 25 35 45 55 22 53 54 55 22 32 42 52 */
  122. /* We first consider Rectangular Full Packed (RFP) Format when N is */
  123. /* odd. We give an example where N = 5. */
  124. /* AP is Upper AP is Lower */
  125. /* 00 01 02 03 04 00 */
  126. /* 11 12 13 14 10 11 */
  127. /* 22 23 24 20 21 22 */
  128. /* 33 34 30 31 32 33 */
  129. /* 44 40 41 42 43 44 */
  130. /* Let TRANSR = 'N'. RFP holds AP as follows: */
  131. /* For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last */
  132. /* three columns of AP upper. The lower triangle A(3:4,0:1) consists of */
  133. /* the transpose of the first two columns of AP upper. */
  134. /* For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first */
  135. /* three columns of AP lower. The upper triangle A(0:1,1:2) consists of */
  136. /* the transpose of the last two columns of AP lower. */
  137. /* This covers the case N odd and TRANSR = 'N'. */
  138. /* RFP A RFP A */
  139. /* 02 03 04 00 33 43 */
  140. /* 12 13 14 10 11 44 */
  141. /* 22 23 24 20 21 22 */
  142. /* 00 33 34 30 31 32 */
  143. /* 01 11 44 40 41 42 */
  144. /* Now let TRANSR = 'T'. RFP A in both UPLO cases is just the */
  145. /* transpose of RFP A above. One therefore gets: */
  146. /* RFP A RFP A */
  147. /* 02 12 22 00 01 00 10 20 30 40 50 */
  148. /* 03 13 23 33 11 33 11 21 31 41 51 */
  149. /* 04 14 24 34 44 43 44 22 32 42 52 */
  150. /* Reference */
  151. /* ========= */
  152. /* ===================================================================== */
  153. /* .. Parameters .. */
  154. /* .. */
  155. /* .. Local Scalars .. */
  156. /* .. */
  157. /* .. External Functions .. */
  158. /* .. */
  159. /* .. External Subroutines .. */
  160. /* .. */
  161. /* .. Intrinsic Functions .. */
  162. /* .. */
  163. /* .. Executable Statements .. */
  164. if (*n == 0) {
  165. ret_val = 0.;
  166. return ret_val;
  167. }
  168. /* set noe = 1 if n is odd. if n is even set noe=0 */
  169. noe = 1;
  170. if (*n % 2 == 0) {
  171. noe = 0;
  172. }
  173. /* set ifm = 0 when form='T or 't' and 1 otherwise */
  174. ifm = 1;
  175. if (_starpu_lsame_(transr, "T")) {
  176. ifm = 0;
  177. }
  178. /* set ilu = 0 when uplo='U or 'u' and 1 otherwise */
  179. ilu = 1;
  180. if (_starpu_lsame_(uplo, "U")) {
  181. ilu = 0;
  182. }
  183. /* set lda = (n+1)/2 when ifm = 0 */
  184. /* set lda = n when ifm = 1 and noe = 1 */
  185. /* set lda = n+1 when ifm = 1 and noe = 0 */
  186. if (ifm == 1) {
  187. if (noe == 1) {
  188. lda = *n;
  189. } else {
  190. /* noe=0 */
  191. lda = *n + 1;
  192. }
  193. } else {
  194. /* ifm=0 */
  195. lda = (*n + 1) / 2;
  196. }
  197. if (_starpu_lsame_(norm, "M")) {
  198. /* Find max(abs(A(i,j))). */
  199. k = (*n + 1) / 2;
  200. value = 0.;
  201. if (noe == 1) {
  202. /* n is odd */
  203. if (ifm == 1) {
  204. /* A is n by k */
  205. i__1 = k - 1;
  206. for (j = 0; j <= i__1; ++j) {
  207. i__2 = *n - 1;
  208. for (i__ = 0; i__ <= i__2; ++i__) {
  209. /* Computing MAX */
  210. d__2 = value, d__3 = (d__1 = a[i__ + j * lda], abs(
  211. d__1));
  212. value = max(d__2,d__3);
  213. }
  214. }
  215. } else {
  216. /* xpose case; A is k by n */
  217. i__1 = *n - 1;
  218. for (j = 0; j <= i__1; ++j) {
  219. i__2 = k - 1;
  220. for (i__ = 0; i__ <= i__2; ++i__) {
  221. /* Computing MAX */
  222. d__2 = value, d__3 = (d__1 = a[i__ + j * lda], abs(
  223. d__1));
  224. value = max(d__2,d__3);
  225. }
  226. }
  227. }
  228. } else {
  229. /* n is even */
  230. if (ifm == 1) {
  231. /* A is n+1 by k */
  232. i__1 = k - 1;
  233. for (j = 0; j <= i__1; ++j) {
  234. i__2 = *n;
  235. for (i__ = 0; i__ <= i__2; ++i__) {
  236. /* Computing MAX */
  237. d__2 = value, d__3 = (d__1 = a[i__ + j * lda], abs(
  238. d__1));
  239. value = max(d__2,d__3);
  240. }
  241. }
  242. } else {
  243. /* xpose case; A is k by n+1 */
  244. i__1 = *n;
  245. for (j = 0; j <= i__1; ++j) {
  246. i__2 = k - 1;
  247. for (i__ = 0; i__ <= i__2; ++i__) {
  248. /* Computing MAX */
  249. d__2 = value, d__3 = (d__1 = a[i__ + j * lda], abs(
  250. d__1));
  251. value = max(d__2,d__3);
  252. }
  253. }
  254. }
  255. }
  256. } else if (_starpu_lsame_(norm, "I") || _starpu_lsame_(norm, "O") || *(unsigned char *)norm == '1') {
  257. /* Find normI(A) ( = norm1(A), since A is symmetric). */
  258. if (ifm == 1) {
  259. k = *n / 2;
  260. if (noe == 1) {
  261. /* n is odd */
  262. if (ilu == 0) {
  263. i__1 = k - 1;
  264. for (i__ = 0; i__ <= i__1; ++i__) {
  265. work[i__] = 0.;
  266. }
  267. i__1 = k;
  268. for (j = 0; j <= i__1; ++j) {
  269. s = 0.;
  270. i__2 = k + j - 1;
  271. for (i__ = 0; i__ <= i__2; ++i__) {
  272. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  273. /* -> A(i,j+k) */
  274. s += aa;
  275. work[i__] += aa;
  276. }
  277. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  278. /* -> A(j+k,j+k) */
  279. work[j + k] = s + aa;
  280. if (i__ == k + k) {
  281. goto L10;
  282. }
  283. ++i__;
  284. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  285. /* -> A(j,j) */
  286. work[j] += aa;
  287. s = 0.;
  288. i__2 = k - 1;
  289. for (l = j + 1; l <= i__2; ++l) {
  290. ++i__;
  291. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  292. /* -> A(l,j) */
  293. s += aa;
  294. work[l] += aa;
  295. }
  296. work[j] += s;
  297. }
  298. L10:
  299. i__ = _starpu_idamax_(n, work, &c__1);
  300. value = work[i__ - 1];
  301. } else {
  302. /* ilu = 1 */
  303. ++k;
  304. /* k=(n+1)/2 for n odd and ilu=1 */
  305. i__1 = *n - 1;
  306. for (i__ = k; i__ <= i__1; ++i__) {
  307. work[i__] = 0.;
  308. }
  309. for (j = k - 1; j >= 0; --j) {
  310. s = 0.;
  311. i__1 = j - 2;
  312. for (i__ = 0; i__ <= i__1; ++i__) {
  313. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  314. /* -> A(j+k,i+k) */
  315. s += aa;
  316. work[i__ + k] += aa;
  317. }
  318. if (j > 0) {
  319. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  320. /* -> A(j+k,j+k) */
  321. s += aa;
  322. work[i__ + k] += s;
  323. /* i=j */
  324. ++i__;
  325. }
  326. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  327. /* -> A(j,j) */
  328. work[j] = aa;
  329. s = 0.;
  330. i__1 = *n - 1;
  331. for (l = j + 1; l <= i__1; ++l) {
  332. ++i__;
  333. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  334. /* -> A(l,j) */
  335. s += aa;
  336. work[l] += aa;
  337. }
  338. work[j] += s;
  339. }
  340. i__ = _starpu_idamax_(n, work, &c__1);
  341. value = work[i__ - 1];
  342. }
  343. } else {
  344. /* n is even */
  345. if (ilu == 0) {
  346. i__1 = k - 1;
  347. for (i__ = 0; i__ <= i__1; ++i__) {
  348. work[i__] = 0.;
  349. }
  350. i__1 = k - 1;
  351. for (j = 0; j <= i__1; ++j) {
  352. s = 0.;
  353. i__2 = k + j - 1;
  354. for (i__ = 0; i__ <= i__2; ++i__) {
  355. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  356. /* -> A(i,j+k) */
  357. s += aa;
  358. work[i__] += aa;
  359. }
  360. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  361. /* -> A(j+k,j+k) */
  362. work[j + k] = s + aa;
  363. ++i__;
  364. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  365. /* -> A(j,j) */
  366. work[j] += aa;
  367. s = 0.;
  368. i__2 = k - 1;
  369. for (l = j + 1; l <= i__2; ++l) {
  370. ++i__;
  371. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  372. /* -> A(l,j) */
  373. s += aa;
  374. work[l] += aa;
  375. }
  376. work[j] += s;
  377. }
  378. i__ = _starpu_idamax_(n, work, &c__1);
  379. value = work[i__ - 1];
  380. } else {
  381. /* ilu = 1 */
  382. i__1 = *n - 1;
  383. for (i__ = k; i__ <= i__1; ++i__) {
  384. work[i__] = 0.;
  385. }
  386. for (j = k - 1; j >= 0; --j) {
  387. s = 0.;
  388. i__1 = j - 1;
  389. for (i__ = 0; i__ <= i__1; ++i__) {
  390. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  391. /* -> A(j+k,i+k) */
  392. s += aa;
  393. work[i__ + k] += aa;
  394. }
  395. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  396. /* -> A(j+k,j+k) */
  397. s += aa;
  398. work[i__ + k] += s;
  399. /* i=j */
  400. ++i__;
  401. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  402. /* -> A(j,j) */
  403. work[j] = aa;
  404. s = 0.;
  405. i__1 = *n - 1;
  406. for (l = j + 1; l <= i__1; ++l) {
  407. ++i__;
  408. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  409. /* -> A(l,j) */
  410. s += aa;
  411. work[l] += aa;
  412. }
  413. work[j] += s;
  414. }
  415. i__ = _starpu_idamax_(n, work, &c__1);
  416. value = work[i__ - 1];
  417. }
  418. }
  419. } else {
  420. /* ifm=0 */
  421. k = *n / 2;
  422. if (noe == 1) {
  423. /* n is odd */
  424. if (ilu == 0) {
  425. n1 = k;
  426. /* n/2 */
  427. ++k;
  428. /* k is the row size and lda */
  429. i__1 = *n - 1;
  430. for (i__ = n1; i__ <= i__1; ++i__) {
  431. work[i__] = 0.;
  432. }
  433. i__1 = n1 - 1;
  434. for (j = 0; j <= i__1; ++j) {
  435. s = 0.;
  436. i__2 = k - 1;
  437. for (i__ = 0; i__ <= i__2; ++i__) {
  438. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  439. /* A(j,n1+i) */
  440. work[i__ + n1] += aa;
  441. s += aa;
  442. }
  443. work[j] = s;
  444. }
  445. /* j=n1=k-1 is special */
  446. s = (d__1 = a[j * lda], abs(d__1));
  447. /* A(k-1,k-1) */
  448. i__1 = k - 1;
  449. for (i__ = 1; i__ <= i__1; ++i__) {
  450. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  451. /* A(k-1,i+n1) */
  452. work[i__ + n1] += aa;
  453. s += aa;
  454. }
  455. work[j] += s;
  456. i__1 = *n - 1;
  457. for (j = k; j <= i__1; ++j) {
  458. s = 0.;
  459. i__2 = j - k - 1;
  460. for (i__ = 0; i__ <= i__2; ++i__) {
  461. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  462. /* A(i,j-k) */
  463. work[i__] += aa;
  464. s += aa;
  465. }
  466. /* i=j-k */
  467. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  468. /* A(j-k,j-k) */
  469. s += aa;
  470. work[j - k] += s;
  471. ++i__;
  472. s = (d__1 = a[i__ + j * lda], abs(d__1));
  473. /* A(j,j) */
  474. i__2 = *n - 1;
  475. for (l = j + 1; l <= i__2; ++l) {
  476. ++i__;
  477. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  478. /* A(j,l) */
  479. work[l] += aa;
  480. s += aa;
  481. }
  482. work[j] += s;
  483. }
  484. i__ = _starpu_idamax_(n, work, &c__1);
  485. value = work[i__ - 1];
  486. } else {
  487. /* ilu=1 */
  488. ++k;
  489. /* k=(n+1)/2 for n odd and ilu=1 */
  490. i__1 = *n - 1;
  491. for (i__ = k; i__ <= i__1; ++i__) {
  492. work[i__] = 0.;
  493. }
  494. i__1 = k - 2;
  495. for (j = 0; j <= i__1; ++j) {
  496. /* process */
  497. s = 0.;
  498. i__2 = j - 1;
  499. for (i__ = 0; i__ <= i__2; ++i__) {
  500. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  501. /* A(j,i) */
  502. work[i__] += aa;
  503. s += aa;
  504. }
  505. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  506. /* i=j so process of A(j,j) */
  507. s += aa;
  508. work[j] = s;
  509. /* is initialised here */
  510. ++i__;
  511. /* i=j process A(j+k,j+k) */
  512. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  513. s = aa;
  514. i__2 = *n - 1;
  515. for (l = k + j + 1; l <= i__2; ++l) {
  516. ++i__;
  517. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  518. /* A(l,k+j) */
  519. s += aa;
  520. work[l] += aa;
  521. }
  522. work[k + j] += s;
  523. }
  524. /* j=k-1 is special :process col A(k-1,0:k-1) */
  525. s = 0.;
  526. i__1 = k - 2;
  527. for (i__ = 0; i__ <= i__1; ++i__) {
  528. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  529. /* A(k,i) */
  530. work[i__] += aa;
  531. s += aa;
  532. }
  533. /* i=k-1 */
  534. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  535. /* A(k-1,k-1) */
  536. s += aa;
  537. work[i__] = s;
  538. /* done with col j=k+1 */
  539. i__1 = *n - 1;
  540. for (j = k; j <= i__1; ++j) {
  541. /* process col j of A = A(j,0:k-1) */
  542. s = 0.;
  543. i__2 = k - 1;
  544. for (i__ = 0; i__ <= i__2; ++i__) {
  545. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  546. /* A(j,i) */
  547. work[i__] += aa;
  548. s += aa;
  549. }
  550. work[j] += s;
  551. }
  552. i__ = _starpu_idamax_(n, work, &c__1);
  553. value = work[i__ - 1];
  554. }
  555. } else {
  556. /* n is even */
  557. if (ilu == 0) {
  558. i__1 = *n - 1;
  559. for (i__ = k; i__ <= i__1; ++i__) {
  560. work[i__] = 0.;
  561. }
  562. i__1 = k - 1;
  563. for (j = 0; j <= i__1; ++j) {
  564. s = 0.;
  565. i__2 = k - 1;
  566. for (i__ = 0; i__ <= i__2; ++i__) {
  567. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  568. /* A(j,i+k) */
  569. work[i__ + k] += aa;
  570. s += aa;
  571. }
  572. work[j] = s;
  573. }
  574. /* j=k */
  575. aa = (d__1 = a[j * lda], abs(d__1));
  576. /* A(k,k) */
  577. s = aa;
  578. i__1 = k - 1;
  579. for (i__ = 1; i__ <= i__1; ++i__) {
  580. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  581. /* A(k,k+i) */
  582. work[i__ + k] += aa;
  583. s += aa;
  584. }
  585. work[j] += s;
  586. i__1 = *n - 1;
  587. for (j = k + 1; j <= i__1; ++j) {
  588. s = 0.;
  589. i__2 = j - 2 - k;
  590. for (i__ = 0; i__ <= i__2; ++i__) {
  591. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  592. /* A(i,j-k-1) */
  593. work[i__] += aa;
  594. s += aa;
  595. }
  596. /* i=j-1-k */
  597. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  598. /* A(j-k-1,j-k-1) */
  599. s += aa;
  600. work[j - k - 1] += s;
  601. ++i__;
  602. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  603. /* A(j,j) */
  604. s = aa;
  605. i__2 = *n - 1;
  606. for (l = j + 1; l <= i__2; ++l) {
  607. ++i__;
  608. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  609. /* A(j,l) */
  610. work[l] += aa;
  611. s += aa;
  612. }
  613. work[j] += s;
  614. }
  615. /* j=n */
  616. s = 0.;
  617. i__1 = k - 2;
  618. for (i__ = 0; i__ <= i__1; ++i__) {
  619. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  620. /* A(i,k-1) */
  621. work[i__] += aa;
  622. s += aa;
  623. }
  624. /* i=k-1 */
  625. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  626. /* A(k-1,k-1) */
  627. s += aa;
  628. work[i__] += s;
  629. i__ = _starpu_idamax_(n, work, &c__1);
  630. value = work[i__ - 1];
  631. } else {
  632. /* ilu=1 */
  633. i__1 = *n - 1;
  634. for (i__ = k; i__ <= i__1; ++i__) {
  635. work[i__] = 0.;
  636. }
  637. /* j=0 is special :process col A(k:n-1,k) */
  638. s = abs(a[0]);
  639. /* A(k,k) */
  640. i__1 = k - 1;
  641. for (i__ = 1; i__ <= i__1; ++i__) {
  642. aa = (d__1 = a[i__], abs(d__1));
  643. /* A(k+i,k) */
  644. work[i__ + k] += aa;
  645. s += aa;
  646. }
  647. work[k] += s;
  648. i__1 = k - 1;
  649. for (j = 1; j <= i__1; ++j) {
  650. /* process */
  651. s = 0.;
  652. i__2 = j - 2;
  653. for (i__ = 0; i__ <= i__2; ++i__) {
  654. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  655. /* A(j-1,i) */
  656. work[i__] += aa;
  657. s += aa;
  658. }
  659. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  660. /* i=j-1 so process of A(j-1,j-1) */
  661. s += aa;
  662. work[j - 1] = s;
  663. /* is initialised here */
  664. ++i__;
  665. /* i=j process A(j+k,j+k) */
  666. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  667. s = aa;
  668. i__2 = *n - 1;
  669. for (l = k + j + 1; l <= i__2; ++l) {
  670. ++i__;
  671. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  672. /* A(l,k+j) */
  673. s += aa;
  674. work[l] += aa;
  675. }
  676. work[k + j] += s;
  677. }
  678. /* j=k is special :process col A(k,0:k-1) */
  679. s = 0.;
  680. i__1 = k - 2;
  681. for (i__ = 0; i__ <= i__1; ++i__) {
  682. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  683. /* A(k,i) */
  684. work[i__] += aa;
  685. s += aa;
  686. }
  687. /* i=k-1 */
  688. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  689. /* A(k-1,k-1) */
  690. s += aa;
  691. work[i__] = s;
  692. /* done with col j=k+1 */
  693. i__1 = *n;
  694. for (j = k + 1; j <= i__1; ++j) {
  695. /* process col j-1 of A = A(j-1,0:k-1) */
  696. s = 0.;
  697. i__2 = k - 1;
  698. for (i__ = 0; i__ <= i__2; ++i__) {
  699. aa = (d__1 = a[i__ + j * lda], abs(d__1));
  700. /* A(j-1,i) */
  701. work[i__] += aa;
  702. s += aa;
  703. }
  704. work[j - 1] += s;
  705. }
  706. i__ = _starpu_idamax_(n, work, &c__1);
  707. value = work[i__ - 1];
  708. }
  709. }
  710. }
  711. } else if (_starpu_lsame_(norm, "F") || _starpu_lsame_(norm, "E")) {
  712. /* Find normF(A). */
  713. k = (*n + 1) / 2;
  714. scale = 0.;
  715. s = 1.;
  716. if (noe == 1) {
  717. /* n is odd */
  718. if (ifm == 1) {
  719. /* A is normal */
  720. if (ilu == 0) {
  721. /* A is upper */
  722. i__1 = k - 3;
  723. for (j = 0; j <= i__1; ++j) {
  724. i__2 = k - j - 2;
  725. _starpu_dlassq_(&i__2, &a[k + j + 1 + j * lda], &c__1, &scale,
  726. &s);
  727. /* L at A(k,0) */
  728. }
  729. i__1 = k - 1;
  730. for (j = 0; j <= i__1; ++j) {
  731. i__2 = k + j - 1;
  732. _starpu_dlassq_(&i__2, &a[j * lda], &c__1, &scale, &s);
  733. /* trap U at A(0,0) */
  734. }
  735. s += s;
  736. /* double s for the off diagonal elements */
  737. i__1 = k - 1;
  738. i__2 = lda + 1;
  739. _starpu_dlassq_(&i__1, &a[k], &i__2, &scale, &s);
  740. /* tri L at A(k,0) */
  741. i__1 = lda + 1;
  742. _starpu_dlassq_(&k, &a[k - 1], &i__1, &scale, &s);
  743. /* tri U at A(k-1,0) */
  744. } else {
  745. /* ilu=1 & A is lower */
  746. i__1 = k - 1;
  747. for (j = 0; j <= i__1; ++j) {
  748. i__2 = *n - j - 1;
  749. _starpu_dlassq_(&i__2, &a[j + 1 + j * lda], &c__1, &scale, &s)
  750. ;
  751. /* trap L at A(0,0) */
  752. }
  753. i__1 = k - 2;
  754. for (j = 0; j <= i__1; ++j) {
  755. _starpu_dlassq_(&j, &a[(j + 1) * lda], &c__1, &scale, &s);
  756. /* U at A(0,1) */
  757. }
  758. s += s;
  759. /* double s for the off diagonal elements */
  760. i__1 = lda + 1;
  761. _starpu_dlassq_(&k, a, &i__1, &scale, &s);
  762. /* tri L at A(0,0) */
  763. i__1 = k - 1;
  764. i__2 = lda + 1;
  765. _starpu_dlassq_(&i__1, &a[lda], &i__2, &scale, &s);
  766. /* tri U at A(0,1) */
  767. }
  768. } else {
  769. /* A is xpose */
  770. if (ilu == 0) {
  771. /* A' is upper */
  772. i__1 = k - 2;
  773. for (j = 1; j <= i__1; ++j) {
  774. _starpu_dlassq_(&j, &a[(k + j) * lda], &c__1, &scale, &s);
  775. /* U at A(0,k) */
  776. }
  777. i__1 = k - 2;
  778. for (j = 0; j <= i__1; ++j) {
  779. _starpu_dlassq_(&k, &a[j * lda], &c__1, &scale, &s);
  780. /* k by k-1 rect. at A(0,0) */
  781. }
  782. i__1 = k - 2;
  783. for (j = 0; j <= i__1; ++j) {
  784. i__2 = k - j - 1;
  785. _starpu_dlassq_(&i__2, &a[j + 1 + (j + k - 1) * lda], &c__1, &
  786. scale, &s);
  787. /* L at A(0,k-1) */
  788. }
  789. s += s;
  790. /* double s for the off diagonal elements */
  791. i__1 = k - 1;
  792. i__2 = lda + 1;
  793. _starpu_dlassq_(&i__1, &a[k * lda], &i__2, &scale, &s);
  794. /* tri U at A(0,k) */
  795. i__1 = lda + 1;
  796. _starpu_dlassq_(&k, &a[(k - 1) * lda], &i__1, &scale, &s);
  797. /* tri L at A(0,k-1) */
  798. } else {
  799. /* A' is lower */
  800. i__1 = k - 1;
  801. for (j = 1; j <= i__1; ++j) {
  802. _starpu_dlassq_(&j, &a[j * lda], &c__1, &scale, &s);
  803. /* U at A(0,0) */
  804. }
  805. i__1 = *n - 1;
  806. for (j = k; j <= i__1; ++j) {
  807. _starpu_dlassq_(&k, &a[j * lda], &c__1, &scale, &s);
  808. /* k by k-1 rect. at A(0,k) */
  809. }
  810. i__1 = k - 3;
  811. for (j = 0; j <= i__1; ++j) {
  812. i__2 = k - j - 2;
  813. _starpu_dlassq_(&i__2, &a[j + 2 + j * lda], &c__1, &scale, &s)
  814. ;
  815. /* L at A(1,0) */
  816. }
  817. s += s;
  818. /* double s for the off diagonal elements */
  819. i__1 = lda + 1;
  820. _starpu_dlassq_(&k, a, &i__1, &scale, &s);
  821. /* tri U at A(0,0) */
  822. i__1 = k - 1;
  823. i__2 = lda + 1;
  824. _starpu_dlassq_(&i__1, &a[1], &i__2, &scale, &s);
  825. /* tri L at A(1,0) */
  826. }
  827. }
  828. } else {
  829. /* n is even */
  830. if (ifm == 1) {
  831. /* A is normal */
  832. if (ilu == 0) {
  833. /* A is upper */
  834. i__1 = k - 2;
  835. for (j = 0; j <= i__1; ++j) {
  836. i__2 = k - j - 1;
  837. _starpu_dlassq_(&i__2, &a[k + j + 2 + j * lda], &c__1, &scale,
  838. &s);
  839. /* L at A(k+1,0) */
  840. }
  841. i__1 = k - 1;
  842. for (j = 0; j <= i__1; ++j) {
  843. i__2 = k + j;
  844. _starpu_dlassq_(&i__2, &a[j * lda], &c__1, &scale, &s);
  845. /* trap U at A(0,0) */
  846. }
  847. s += s;
  848. /* double s for the off diagonal elements */
  849. i__1 = lda + 1;
  850. _starpu_dlassq_(&k, &a[k + 1], &i__1, &scale, &s);
  851. /* tri L at A(k+1,0) */
  852. i__1 = lda + 1;
  853. _starpu_dlassq_(&k, &a[k], &i__1, &scale, &s);
  854. /* tri U at A(k,0) */
  855. } else {
  856. /* ilu=1 & A is lower */
  857. i__1 = k - 1;
  858. for (j = 0; j <= i__1; ++j) {
  859. i__2 = *n - j - 1;
  860. _starpu_dlassq_(&i__2, &a[j + 2 + j * lda], &c__1, &scale, &s)
  861. ;
  862. /* trap L at A(1,0) */
  863. }
  864. i__1 = k - 1;
  865. for (j = 1; j <= i__1; ++j) {
  866. _starpu_dlassq_(&j, &a[j * lda], &c__1, &scale, &s);
  867. /* U at A(0,0) */
  868. }
  869. s += s;
  870. /* double s for the off diagonal elements */
  871. i__1 = lda + 1;
  872. _starpu_dlassq_(&k, &a[1], &i__1, &scale, &s);
  873. /* tri L at A(1,0) */
  874. i__1 = lda + 1;
  875. _starpu_dlassq_(&k, a, &i__1, &scale, &s);
  876. /* tri U at A(0,0) */
  877. }
  878. } else {
  879. /* A is xpose */
  880. if (ilu == 0) {
  881. /* A' is upper */
  882. i__1 = k - 1;
  883. for (j = 1; j <= i__1; ++j) {
  884. _starpu_dlassq_(&j, &a[(k + 1 + j) * lda], &c__1, &scale, &s);
  885. /* U at A(0,k+1) */
  886. }
  887. i__1 = k - 1;
  888. for (j = 0; j <= i__1; ++j) {
  889. _starpu_dlassq_(&k, &a[j * lda], &c__1, &scale, &s);
  890. /* k by k rect. at A(0,0) */
  891. }
  892. i__1 = k - 2;
  893. for (j = 0; j <= i__1; ++j) {
  894. i__2 = k - j - 1;
  895. _starpu_dlassq_(&i__2, &a[j + 1 + (j + k) * lda], &c__1, &
  896. scale, &s);
  897. /* L at A(0,k) */
  898. }
  899. s += s;
  900. /* double s for the off diagonal elements */
  901. i__1 = lda + 1;
  902. _starpu_dlassq_(&k, &a[(k + 1) * lda], &i__1, &scale, &s);
  903. /* tri U at A(0,k+1) */
  904. i__1 = lda + 1;
  905. _starpu_dlassq_(&k, &a[k * lda], &i__1, &scale, &s);
  906. /* tri L at A(0,k) */
  907. } else {
  908. /* A' is lower */
  909. i__1 = k - 1;
  910. for (j = 1; j <= i__1; ++j) {
  911. _starpu_dlassq_(&j, &a[(j + 1) * lda], &c__1, &scale, &s);
  912. /* U at A(0,1) */
  913. }
  914. i__1 = *n;
  915. for (j = k + 1; j <= i__1; ++j) {
  916. _starpu_dlassq_(&k, &a[j * lda], &c__1, &scale, &s);
  917. /* k by k rect. at A(0,k+1) */
  918. }
  919. i__1 = k - 2;
  920. for (j = 0; j <= i__1; ++j) {
  921. i__2 = k - j - 1;
  922. _starpu_dlassq_(&i__2, &a[j + 1 + j * lda], &c__1, &scale, &s)
  923. ;
  924. /* L at A(0,0) */
  925. }
  926. s += s;
  927. /* double s for the off diagonal elements */
  928. i__1 = lda + 1;
  929. _starpu_dlassq_(&k, &a[lda], &i__1, &scale, &s);
  930. /* tri L at A(0,1) */
  931. i__1 = lda + 1;
  932. _starpu_dlassq_(&k, a, &i__1, &scale, &s);
  933. /* tri U at A(0,0) */
  934. }
  935. }
  936. }
  937. value = scale * sqrt(s);
  938. }
  939. ret_val = value;
  940. return ret_val;
  941. /* End of DLANSF */
  942. } /* _starpu_dlansf_ */