Advertisement
Guest User

Untitled

a guest
Nov 18th, 2019
161
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 24.25 KB | None | 0 0
  1. # include <cstdlib>
  2. # include <iostream>
  3. # include <iomanip>
  4. # include <cmath>
  5. # include <ctime>
  6.  
  7. using namespace std;
  8.  
  9. int main ( void );
  10. double cpu_time ( void );
  11. double r8_abs ( double x );
  12. double r8_epsilon ( void );
  13. double *r8_matgen ( int lda, int n );
  14. double r8_max ( double x, double y );
  15. double r8_random ( int iseed[4] );
  16. void daxpy ( int n, double da, double dx[], int incx, double dy[], int incy );
  17. double ddot ( int n, double dx[], int incx, double dy[], int incy );
  18. int dgefa ( double a[], int lda, int n, int ipvt[] );
  19. void dgesl ( double a[], int lda, int n, int ipvt[], double b[], int job );
  20. void dscal ( int n, double sa, double x[], int incx );
  21. int idamax ( int n, double dx[], int incx );
  22. void timestamp ( void );
  23.  
  24. //****************************************************************************80
  25.  
  26. int main ( void )
  27.  
  28. //****************************************************************************80
  29. //
  30. // Purpose:
  31. //
  32. // LINPACK_BENCH drives the double precision LINPACK benchmark program.
  33. //
  34. {
  35. # define N 1000
  36. # define LDA ( N + 1 )
  37.  
  38. double *a;
  39. double a_max;
  40. double *b;
  41. double b_max;
  42. double cray = 0.056;
  43. double eps;
  44. int i;
  45. int info;
  46. int *ipvt;
  47. int j;
  48. int job;
  49. double ops;
  50. double *resid;
  51. double resid_max;
  52. double residn;
  53. double *rhs;
  54. double t1;
  55. double t2;
  56. double time[6];
  57. double total;
  58. double *x;
  59. //
  60. // This program was updated on 10/12/92 to correct a
  61. // problem with the random number generator. The previous
  62. // random number generator had a short period and produced
  63. // singular matrices occasionally.
  64. //
  65. timestamp ( );
  66. cout << "\n";
  67. cout << "LINPACK_BENCH\n";
  68. cout << " The LINPACK benchmark.\n";
  69. cout << " Language: C++\n";
  70. cout << " Datatype: Double\n";
  71.  
  72. ops = ( double ) ( 2 * N * N * N ) / 3.0 + 2.0 * ( double ) ( N * N );
  73.  
  74. a = r8_matgen ( LDA, N );
  75. b = new double[N];
  76. ipvt = new int[N];
  77. resid = new double[N];
  78. rhs = new double[N];
  79. x = new double[N];
  80.  
  81. a_max = 0.0;
  82. for ( j = 1; j <= N; j++ )
  83. {
  84. for ( i = 1; i <= N; i++ )
  85. {
  86. a_max = r8_max ( a_max, a[i-1+(j-1)*LDA] );
  87. }
  88. }
  89.  
  90. for ( i = 1; i <= N; i++ )
  91. {
  92. x[i-1] = 1.0;
  93. }
  94.  
  95. for ( i = 1; i <= N; i++ )
  96. {
  97. b[i-1] = 0.0;
  98. for ( j = 1; j <= N; j++ )
  99. {
  100. b[i-1] = b[i-1] + a[i-1+(j-1)*LDA] * x[j-1];
  101. }
  102. }
  103. //
  104. // DEBUG:
  105. //
  106. b_max = 0.0;
  107. for ( i = 1; i <= N; i++ )
  108. {
  109. b_max = r8_max ( b_max, r8_abs ( b[i-1] ) );
  110. }
  111. t1 = cpu_time ( );
  112.  
  113. info = dgefa ( a, LDA, N, ipvt );
  114.  
  115. if ( info != 0 )
  116. {
  117. cout << "\n";
  118. cout << "LINPACK_BENCH - Fatal error!\n";
  119. cout << " The matrix A is apparently singular.\n";
  120. cout << " Abnormal end of execution.\n";
  121. return 1;
  122. }
  123.  
  124. t2 = cpu_time ( );
  125. time[0] = t2 - t1;
  126.  
  127. t1 = cpu_time ( );
  128.  
  129. job = 0;
  130. dgesl ( a, LDA, N, ipvt, b, job );
  131.  
  132. t2 = cpu_time ( );
  133. time[1] = t2 - t1;
  134.  
  135. total = time[0] + time[1];
  136.  
  137. delete [] a;
  138. //
  139. // Compute a residual to verify results.
  140. //
  141. a = r8_matgen ( LDA, N );
  142.  
  143. for ( i = 1; i <= N; i++ )
  144. {
  145. x[i-1] = 1.0;
  146. }
  147.  
  148. for ( i = 1; i <= N; i++ )
  149. {
  150. rhs[i-1] = 0.0;
  151. for ( j = 1; j <= N; j++ )
  152. {
  153. rhs[i-1] = rhs[i-1] + a[i-1+(j-1)*LDA] * x[j-1];
  154. }
  155. }
  156.  
  157. for ( i = 1; i <= N; i++ )
  158. {
  159. resid[i-1] = -rhs[i-1];
  160. for ( j = 1; j <= N; j++ )
  161. {
  162. resid[i-1] = resid[i-1] + a[i-1+(j-1)*LDA] * b[j-1];
  163. }
  164. }
  165.  
  166. resid_max = 0.0;
  167. for ( i = 1; i <= N; i++ )
  168. {
  169. resid_max = r8_max ( resid_max, r8_abs ( resid[i-1] ) );
  170. }
  171.  
  172. b_max = 0.0;
  173. for ( i = 1; i <= N; i++ )
  174. {
  175. b_max = r8_max ( b_max, r8_abs ( b[i-1] ) );
  176. }
  177.  
  178. eps = r8_epsilon ( );
  179.  
  180. residn = resid_max / ( ( double ) N * a_max * b_max * eps );
  181.  
  182. time[2] = total;
  183. if ( 0.0 < total )
  184. {
  185. time[3] = ops / ( 1.0E+06 * total );
  186. }
  187. else
  188. {
  189. time[3] = -1.0;
  190. }
  191. time[4] = 2.0 / time[3];
  192. time[5] = total / cray;
  193.  
  194. cout << "\n";
  195. cout << " Norm. Resid Resid MACHEP X[1] X[N]\n";
  196. cout << "\n";
  197. cout << setw(14) << residn << " "
  198. << setw(14) << resid_max << " "
  199. << setw(14) << eps << " "
  200. << setw(14) << b[0] << " "
  201. << setw(14) << b[N-1] << "\n";
  202. cout << "\n";
  203. cout << " Times are reported for matrices of order N = " << N << "\n";
  204. cout << " with leading array dimension of LDA = " << LDA << "\n";
  205. cout << "\n";
  206. cout << " Factor Solve Total MFLOPS Unit Ratio\n";
  207. cout << "\n";
  208. cout << setw(9) << time[0] << " "
  209. << setw(9) << time[1] << " "
  210. << setw(9) << time[2] << " "
  211. << setw(9) << time[3] << " "
  212. << setw(9) << time[4] << " "
  213. << setw(9) << time[5] << "\n";
  214. cout << "\n";
  215. cout << " End of tests -- This version dated 10/12/92.\n";
  216.  
  217. delete [] a;
  218. delete [] b;
  219. delete [] ipvt;
  220. delete [] resid;
  221. delete [] rhs;
  222. delete [] x;
  223.  
  224. cout << "\n";
  225. cout << "LINPACK_BENCH\n";
  226. cout << " Normal end of execution.\n";
  227.  
  228. cout << "\n";
  229. timestamp ( );
  230.  
  231. return 0;
  232. # undef LDA
  233. # undef N
  234. }
  235. //****************************************************************************80
  236.  
  237. double cpu_time ( void )
  238.  
  239. //****************************************************************************80
  240. //
  241. // Purpose:
  242. //
  243. // CPU_TIME returns the current reading on the CPU clock.
  244. //
  245. // Modified:
  246. //
  247. // 06 June 2005
  248. //
  249. // Author:
  250. //
  251. // John Burkardt
  252. //
  253. // Parameters:
  254. //
  255. // Output, double CPU_TIME, the current reading of the CPU clock, in seconds.
  256. //
  257. {
  258. double value;
  259.  
  260. value = ( double ) ( clock ( ) / CLOCKS_PER_SEC );
  261.  
  262. return value;
  263. }
  264. //****************************************************************************80
  265.  
  266. double r8_abs ( double x )
  267.  
  268. //****************************************************************************80
  269. //
  270. // Purpose:
  271. //
  272. // R8_ABS returns the absolute value of a double precision number.
  273. //
  274. // Modified:
  275. //
  276. // 02 April 2005
  277. //
  278. // Author:
  279. //
  280. // John Burkardt
  281. //
  282. // Parameters:
  283. //
  284. // Input, double X, the quantity whose absolute value is desired.
  285. //
  286. // Output, double R8_ABS, the absolute value of X.
  287. //
  288. {
  289. if ( 0.0 <= x )
  290. {
  291. return x;
  292. }
  293. else
  294. {
  295. return ( -x );
  296. }
  297. }
  298. //****************************************************************************80
  299.  
  300. double r8_epsilon ( void )
  301.  
  302. //****************************************************************************80
  303. //
  304. // Purpose:
  305. //
  306. // R8_EPSILON returns the round off unit for double precision arithmetic.
  307. //
  308. // Discussion:
  309. //
  310. // R8_EPSILON is a number R which is a power of 2 with the property that,
  311. // to the precision of the computer's arithmetic,
  312. // 1 < 1 + R
  313. // but
  314. // 1 = ( 1 + R / 2 )
  315. //
  316. // Modified:
  317. //
  318. // 01 July 2004
  319. //
  320. // Author:
  321. //
  322. // John Burkardt
  323. //
  324. // Parameters:
  325. //
  326. // Output, double R8_EPSILON, the double precision round-off unit.
  327. //
  328. {
  329. double r;
  330.  
  331. r = 1.0E+00;
  332.  
  333. while ( 1.0E+00 < ( double ) ( 1.0E+00 + r ) )
  334. {
  335. r = r / 2.0E+00;
  336. }
  337.  
  338. return ( 2.0E+00 * r );
  339. }
  340. //****************************************************************************80
  341.  
  342. double *r8_matgen ( int lda, int n )
  343.  
  344. //****************************************************************************80
  345. //
  346. // Purpose:
  347. //
  348. // R8_MATGEN generates a random matrix.
  349. //
  350. // Modified:
  351. //
  352. // 06 June 2005
  353. //
  354. // Parameters:
  355. //
  356. // Input, integer LDA, the leading dimension of the matrix.
  357. //
  358. // Input, integer N, the order of the matrix.
  359. //
  360. // Output, double R8_MATGEN[LDA*N], the N by N matrix.
  361. //
  362. {
  363. double *a;
  364. int i;
  365. int init[4] = { 1, 2, 3, 1325 };
  366. int j;
  367.  
  368. a = new double[lda*n];
  369.  
  370. for ( j = 1; j <= n; j++ )
  371. {
  372. for ( i = 1; i <= n; i++ )
  373. {
  374. a[i-1+(j-1)*lda] = r8_random ( init ) - 0.5;
  375. }
  376. }
  377.  
  378. return a;
  379. }
  380. //****************************************************************************80
  381.  
  382. double r8_max ( double x, double y )
  383.  
  384. //****************************************************************************80
  385. //
  386. // Purpose:
  387. //
  388. // R8_MAX returns the maximum of two double precision values.
  389. //
  390. // Modified:
  391. //
  392. // 18 August 2004
  393. //
  394. // Author:
  395. //
  396. // John Burkardt
  397. //
  398. // Parameters:
  399. //
  400. // Input, double X, Y, the quantities to compare.
  401. //
  402. // Output, double R8_MAX, the maximum of X and Y.
  403. //
  404. {
  405. if ( y < x )
  406. {
  407. return x;
  408. }
  409. else
  410. {
  411. return y;
  412. }
  413. }
  414. //****************************************************************************80
  415.  
  416. double r8_random ( int iseed[4] )
  417.  
  418. //****************************************************************************80
  419. //
  420. // Purpose:
  421. //
  422. // R8_RANDOM returns a uniformly distributed random number between 0 and 1.
  423. //
  424. // Discussion:
  425. //
  426. // This routine uses a multiplicative congruential method with modulus
  427. // 2**48 and multiplier 33952834046453 (see G.S.Fishman,
  428. // 'Multiplicative congruential random number generators with modulus
  429. // 2**b: an exhaustive analysis for b = 32 and a partial analysis for
  430. // b = 48', Math. Comp. 189, pp 331-344, 1990).
  431. //
  432. // 48-bit integers are stored in 4 integer array elements with 12 bits
  433. // per element. Hence the routine is portable across machines with
  434. // integers of 32 bits or more.
  435. //
  436. // Parameters:
  437. //
  438. // Input/output, integer ISEED(4).
  439. // On entry, the seed of the random number generator; the array
  440. // elements must be between 0 and 4095, and ISEED(4) must be odd.
  441. // On exit, the seed is updated.
  442. //
  443. // Output, double R8_RANDOM, the next pseudorandom number.
  444. //
  445. {
  446. int ipw2 = 4096;
  447. int it1;
  448. int it2;
  449. int it3;
  450. int it4;
  451. int m1 = 494;
  452. int m2 = 322;
  453. int m3 = 2508;
  454. int m4 = 2549;
  455. double one = 1.0;
  456. double r = 1.0 / 4096.0;
  457. double value;
  458. //
  459. // Multiply the seed by the multiplier modulo 2**48.
  460. //
  461. it4 = iseed[3] * m4;
  462. it3 = it4 / ipw2;
  463. it4 = it4 - ipw2 * it3;
  464. it3 = it3 + iseed[2] * m4 + iseed[3] * m3;
  465. it2 = it3 / ipw2;
  466. it3 = it3 - ipw2 * it2;
  467. it2 = it2 + iseed[1] * m4 + iseed[2] * m3 + iseed[3] * m2;
  468. it1 = it2 / ipw2;
  469. it2 = it2 - ipw2 * it1;
  470. it1 = it1 + iseed[0] * m4 + iseed[1] * m3 + iseed[2] * m2 + iseed[3] * m1;
  471. it1 = ( it1 % ipw2 );
  472. //
  473. // Return updated seed
  474. //
  475. iseed[0] = it1;
  476. iseed[1] = it2;
  477. iseed[2] = it3;
  478. iseed[3] = it4;
  479. //
  480. // Convert 48-bit integer to a real number in the interval (0,1)
  481. //
  482. value =
  483. r * ( ( double ) ( it1 )
  484. + r * ( ( double ) ( it2 )
  485. + r * ( ( double ) ( it3 )
  486. + r * ( ( double ) ( it4 ) ) ) ) );
  487.  
  488. return value;
  489. }
  490. //****************************************************************************80
  491.  
  492. void daxpy ( int n, double da, double dx[], int incx, double dy[], int incy )
  493.  
  494. //****************************************************************************80
  495. //
  496. // Purpose:
  497. //
  498. // DAXPY computes constant times a vector plus a vector.
  499. //
  500. // Discussion:
  501. //
  502. // This routine uses unrolled loops for increments equal to one.
  503. //
  504. // Modified:
  505. //
  506. // 02 May 2005
  507. //
  508. // Author:
  509. //
  510. // Jack Dongarra
  511. //
  512. // Reference:
  513. //
  514. // Dongarra, Moler, Bunch, Stewart,
  515. // LINPACK User's Guide,
  516. // SIAM, 1979.
  517. //
  518. // Lawson, Hanson, Kincaid, Krogh,
  519. // Basic Linear Algebra Subprograms for Fortran Usage,
  520. // Algorithm 539,
  521. // ACM Transactions on Mathematical Software,
  522. // Volume 5, Number 3, September 1979, pages 308-323.
  523. //
  524. // Parameters:
  525. //
  526. // Input, int N, the number of elements in DX and DY.
  527. //
  528. // Input, double DA, the multiplier of DX.
  529. //
  530. // Input, double DX[*], the first vector.
  531. //
  532. // Input, int INCX, the increment between successive entries of DX.
  533. //
  534. // Input/output, double DY[*], the second vector.
  535. // On output, DY[*] has been replaced by DY[*] + DA * DX[*].
  536. //
  537. // Input, int INCY, the increment between successive entries of DY.
  538. //
  539. {
  540. int i;
  541. int ix;
  542. int iy;
  543. int m;
  544.  
  545. if ( n <= 0 )
  546. {
  547. return;
  548. }
  549.  
  550. if ( da == 0.0 )
  551. {
  552. return;
  553. }
  554. //
  555. // Code for unequal increments or equal increments
  556. // not equal to 1.
  557. //
  558. if ( incx != 1 || incy != 1 )
  559. {
  560. if ( 0 <= incx )
  561. {
  562. ix = 0;
  563. }
  564. else
  565. {
  566. ix = ( - n + 1 ) * incx;
  567. }
  568.  
  569. if ( 0 <= incy )
  570. {
  571. iy = 0;
  572. }
  573. else
  574. {
  575. iy = ( - n + 1 ) * incy;
  576. }
  577.  
  578. for ( i = 0; i < n; i++ )
  579. {
  580. dy[iy] = dy[iy] + da * dx[ix];
  581. ix = ix + incx;
  582. iy = iy + incy;
  583. }
  584. }
  585. //
  586. // Code for both increments equal to 1.
  587. //
  588. else
  589. {
  590. m = n % 4;
  591.  
  592. for ( i = 0; i < m; i++ )
  593. {
  594. dy[i] = dy[i] + da * dx[i];
  595. }
  596.  
  597. for ( i = m; i < n; i = i + 4 )
  598. {
  599. dy[i ] = dy[i ] + da * dx[i ];
  600. dy[i+1] = dy[i+1] + da * dx[i+1];
  601. dy[i+2] = dy[i+2] + da * dx[i+2];
  602. dy[i+3] = dy[i+3] + da * dx[i+3];
  603. }
  604.  
  605. }
  606.  
  607. return;
  608. }
  609. //****************************************************************************80
  610.  
  611. double ddot ( int n, double dx[], int incx, double dy[], int incy )
  612.  
  613. //****************************************************************************80
  614. //
  615. // Purpose:
  616. //
  617. // DDOT forms the dot product of two vectors.
  618. //
  619. // Discussion:
  620. //
  621. // This routine uses unrolled loops for increments equal to one.
  622. //
  623. // Modified:
  624. //
  625. // 02 May 2005
  626. //
  627. // Author:
  628. //
  629. // Jack Dongarra
  630. //
  631. // Reference:
  632. //
  633. // Dongarra, Moler, Bunch, Stewart,
  634. // LINPACK User's Guide,
  635. // SIAM, 1979.
  636. //
  637. // Lawson, Hanson, Kincaid, Krogh,
  638. // Basic Linear Algebra Subprograms for Fortran Usage,
  639. // Algorithm 539,
  640. // ACM Transactions on Mathematical Software,
  641. // Volume 5, Number 3, September 1979, pages 308-323.
  642. //
  643. // Parameters:
  644. //
  645. // Input, int N, the number of entries in the vectors.
  646. //
  647. // Input, double DX[*], the first vector.
  648. //
  649. // Input, int INCX, the increment between successive entries in DX.
  650. //
  651. // Input, double DY[*], the second vector.
  652. //
  653. // Input, int INCY, the increment between successive entries in DY.
  654. //
  655. // Output, double DDOT, the sum of the product of the corresponding
  656. // entries of DX and DY.
  657. //
  658. {
  659. double dtemp;
  660. int i;
  661. int ix;
  662. int iy;
  663. int m;
  664.  
  665. dtemp = 0.0;
  666.  
  667. if ( n <= 0 )
  668. {
  669. return dtemp;
  670. }
  671. //
  672. // Code for unequal increments or equal increments
  673. // not equal to 1.
  674. //
  675. if ( incx != 1 || incy != 1 )
  676. {
  677. if ( 0 <= incx )
  678. {
  679. ix = 0;
  680. }
  681. else
  682. {
  683. ix = ( - n + 1 ) * incx;
  684. }
  685.  
  686. if ( 0 <= incy )
  687. {
  688. iy = 0;
  689. }
  690. else
  691. {
  692. iy = ( - n + 1 ) * incy;
  693. }
  694.  
  695. for ( i = 0; i < n; i++ )
  696. {
  697. dtemp = dtemp + dx[ix] * dy[iy];
  698. ix = ix + incx;
  699. iy = iy + incy;
  700. }
  701. }
  702. //
  703. // Code for both increments equal to 1.
  704. //
  705. else
  706. {
  707. m = n % 5;
  708.  
  709. for ( i = 0; i < m; i++ )
  710. {
  711. dtemp = dtemp + dx[i] * dy[i];
  712. }
  713.  
  714. for ( i = m; i < n; i = i + 5 )
  715. {
  716. dtemp = dtemp + dx[i ] * dy[i ]
  717. + dx[i+1] * dy[i+1]
  718. + dx[i+2] * dy[i+2]
  719. + dx[i+3] * dy[i+3]
  720. + dx[i+4] * dy[i+4];
  721. }
  722.  
  723. }
  724.  
  725. return dtemp;
  726. }
  727. //****************************************************************************80
  728.  
  729. int dgefa ( double a[], int lda, int n, int ipvt[] )
  730.  
  731. //****************************************************************************80
  732. //
  733. // Purpose:
  734. //
  735. // DGEFA factors a real general matrix.
  736. //
  737. // Modified:
  738. //
  739. // 16 May 2005
  740. //
  741. // Author:
  742. //
  743. // C++ translation by John Burkardt.
  744. //
  745. // Reference:
  746. //
  747. // Dongarra, Moler, Bunch and Stewart,
  748. // LINPACK User's Guide,
  749. // SIAM, (Society for Industrial and Applied Mathematics),
  750. // 3600 University City Science Center,
  751. // Philadelphia, PA, 19104-2688.
  752. // ISBN 0-89871-172-X
  753. //
  754. // Parameters:
  755. //
  756. // Input/output, double A[LDA*N].
  757. // On intput, the matrix to be factored.
  758. // On output, an upper triangular matrix and the multipliers used to obtain
  759. // it. The factorization can be written A=L*U, where L is a product of
  760. // permutation and unit lower triangular matrices, and U is upper triangular.
  761. //
  762. // Input, int LDA, the leading dimension of A.
  763. //
  764. // Input, int N, the order of the matrix A.
  765. //
  766. // Output, int IPVT[N], the pivot indices.
  767. //
  768. // Output, int DGEFA, singularity indicator.
  769. // 0, normal value.
  770. // K, if U(K,K) == 0. This is not an error condition for this subroutine,
  771. // but it does indicate that DGESL or DGEDI will divide by zero if called.
  772. // Use RCOND in DGECO for a reliable indication of singularity.
  773. //
  774. {
  775. int info;
  776. int j;
  777. int k;
  778. int l;
  779. double t;
  780. //
  781. // Gaussian elimination with partial pivoting.
  782. //
  783. info = 0;
  784.  
  785. for ( k = 1; k <= n-1; k++ )
  786. {
  787. //
  788. // Find L = pivot index.
  789. //
  790. l = idamax ( n-k+1, a+(k-1)+(k-1)*lda, 1 ) + k - 1;
  791. ipvt[k-1] = l;
  792. //
  793. // Zero pivot implies this column already triangularized.
  794. //
  795. if ( a[l-1+(k-1)*lda] == 0.0 )
  796. {
  797. info = k;
  798. continue;
  799. }
  800. //
  801. // Interchange if necessary.
  802. //
  803. if ( l != k )
  804. {
  805. t = a[l-1+(k-1)*lda];
  806. a[l-1+(k-1)*lda] = a[k-1+(k-1)*lda];
  807. a[k-1+(k-1)*lda] = t;
  808. }
  809. //
  810. // Compute multipliers.
  811. //
  812. t = -1.0 / a[k-1+(k-1)*lda];
  813.  
  814. dscal ( n-k, t, a+k+(k-1)*lda, 1 );
  815. //
  816. // Row elimination with column indexing.
  817. //
  818. for ( j = k+1; j <= n; j++ )
  819. {
  820. t = a[l-1+(j-1)*lda];
  821. if ( l != k )
  822. {
  823. a[l-1+(j-1)*lda] = a[k-1+(j-1)*lda];
  824. a[k-1+(j-1)*lda] = t;
  825. }
  826. daxpy ( n-k, t, a+k+(k-1)*lda, 1, a+k+(j-1)*lda, 1 );
  827. }
  828.  
  829. }
  830.  
  831. ipvt[n-1] = n;
  832.  
  833. if ( a[n-1+(n-1)*lda] == 0.0 )
  834. {
  835. info = n;
  836. }
  837.  
  838. return info;
  839. }
  840. //****************************************************************************80
  841.  
  842. void dgesl ( double a[], int lda, int n, int ipvt[], double b[], int job )
  843.  
  844. //****************************************************************************80
  845. //
  846. // Purpose:
  847. //
  848. // DGESL solves a real general linear system A * X = B.
  849. //
  850. // Discussion:
  851. //
  852. // DGESL can solve either of the systems A * X = B or A' * X = B.
  853. //
  854. // The system matrix must have been factored by DGECO or DGEFA.
  855. //
  856. // A division by zero will occur if the input factor contains a
  857. // zero on the diagonal. Technically this indicates singularity
  858. // but it is often caused by improper arguments or improper
  859. // setting of LDA. It will not occur if the subroutines are
  860. // called correctly and if DGECO has set 0.0 < RCOND
  861. // or DGEFA has set INFO == 0.
  862. //
  863. // Modified:
  864. //
  865. // 16 May 2005
  866. //
  867. // Author:
  868. //
  869. // C++ translation by John Burkardt.
  870. //
  871. // Reference:
  872. //
  873. // Dongarra, Moler, Bunch and Stewart,
  874. // LINPACK User's Guide,
  875. // SIAM, (Society for Industrial and Applied Mathematics),
  876. // 3600 University City Science Center,
  877. // Philadelphia, PA, 19104-2688.
  878. // ISBN 0-89871-172-X
  879. //
  880. // Parameters:
  881. //
  882. // Input, double A[LDA*N], the output from DGECO or DGEFA.
  883. //
  884. // Input, int LDA, the leading dimension of A.
  885. //
  886. // Input, int N, the order of the matrix A.
  887. //
  888. // Input, int IPVT[N], the pivot vector from DGECO or DGEFA.
  889. //
  890. // Input/output, double B[N].
  891. // On input, the right hand side vector.
  892. // On output, the solution vector.
  893. //
  894. // Input, int JOB.
  895. // 0, solve A * X = B;
  896. // nonzero, solve A' * X = B.
  897. //
  898. {
  899. int k;
  900. int l;
  901. double t;
  902. //
  903. // Solve A * X = B.
  904. //
  905. if ( job == 0 )
  906. {
  907. for ( k = 1; k <= n-1; k++ )
  908. {
  909. l = ipvt[k-1];
  910. t = b[l-1];
  911.  
  912. if ( l != k )
  913. {
  914. b[l-1] = b[k-1];
  915. b[k-1] = t;
  916. }
  917.  
  918. daxpy ( n-k, t, a+k+(k-1)*lda, 1, b+k, 1 );
  919.  
  920. }
  921.  
  922. for ( k = n; 1 <= k; k-- )
  923. {
  924. b[k-1] = b[k-1] / a[k-1+(k-1)*lda];
  925. t = -b[k-1];
  926. daxpy ( k-1, t, a+0+(k-1)*lda, 1, b, 1 );
  927. }
  928. }
  929. //
  930. // Solve A' * X = B.
  931. //
  932. else
  933. {
  934. for ( k = 1; k <= n; k++ )
  935. {
  936. t = ddot ( k-1, a+0+(k-1)*lda, 1, b, 1 );
  937. b[k-1] = ( b[k-1] - t ) / a[k-1+(k-1)*lda];
  938. }
  939.  
  940. for ( k = n-1; 1 <= k; k-- )
  941. {
  942. b[k-1] = b[k-1] + ddot ( n-k, a+k+(k-1)*lda, 1, b+k, 1 );
  943. l = ipvt[k-1];
  944.  
  945. if ( l != k )
  946. {
  947. t = b[l-1];
  948. b[l-1] = b[k-1];
  949. b[k-1] = t;
  950. }
  951. }
  952. }
  953. return;
  954. }
  955. //****************************************************************************80
  956.  
  957. void dscal ( int n, double sa, double x[], int incx )
  958.  
  959. //****************************************************************************80
  960. //
  961. // Purpose:
  962. //
  963. // DSCAL scales a vector by a constant.
  964. //
  965. // Modified:
  966. //
  967. // 02 May 2005
  968. //
  969. // Author:
  970. //
  971. // Jack Dongarra
  972. //
  973. // Reference:
  974. //
  975. // Dongarra, Moler, Bunch, Stewart,
  976. // LINPACK User's Guide,
  977. // SIAM, 1979.
  978. //
  979. // Lawson, Hanson, Kincaid, Krogh,
  980. // Basic Linear Algebra Subprograms for Fortran Usage,
  981. // Algorithm 539,
  982. // ACM Transactions on Mathematical Software,
  983. // Volume 5, Number 3, September 1979, pages 308-323.
  984. //
  985. // Parameters:
  986. //
  987. // Input, int N, the number of entries in the vector.
  988. //
  989. // Input, double SA, the multiplier.
  990. //
  991. // Input/output, double X[*], the vector to be scaled.
  992. //
  993. // Input, int INCX, the increment between successive entries of X.
  994. //
  995. {
  996. int i;
  997. int ix;
  998. int m;
  999.  
  1000. if ( n <= 0 )
  1001. {
  1002. }
  1003. else if ( incx == 1 )
  1004. {
  1005. m = n % 5;
  1006.  
  1007. for ( i = 0; i < m; i++ )
  1008. {
  1009. x[i] = sa * x[i];
  1010. }
  1011.  
  1012. for ( i = m; i < n; i = i + 5 )
  1013. {
  1014. x[i] = sa * x[i];
  1015. x[i+1] = sa * x[i+1];
  1016. x[i+2] = sa * x[i+2];
  1017. x[i+3] = sa * x[i+3];
  1018. x[i+4] = sa * x[i+4];
  1019. }
  1020. }
  1021. else
  1022. {
  1023. if ( 0 <= incx )
  1024. {
  1025. ix = 0;
  1026. }
  1027. else
  1028. {
  1029. ix = ( - n + 1 ) * incx;
  1030. }
  1031.  
  1032. for ( i = 0; i < n; i++ )
  1033. {
  1034. x[ix] = sa * x[ix];
  1035. ix = ix + incx;
  1036. }
  1037.  
  1038. }
  1039.  
  1040. return;
  1041. }
  1042. //****************************************************************************80
  1043.  
  1044. int idamax ( int n, double dx[], int incx )
  1045.  
  1046. //****************************************************************************80
  1047. //
  1048. // Purpose:
  1049. //
  1050. // IDAMAX finds the index of the vector element of maximum absolute value.
  1051. //
  1052. // Modified:
  1053. //
  1054. // 02 May 2005
  1055. //
  1056. // Reference:
  1057. //
  1058. // Dongarra, Moler, Bunch, Stewart,
  1059. // LINPACK User's Guide,
  1060. // SIAM, 1979.
  1061. //
  1062. // Lawson, Hanson, Kincaid, Krogh,
  1063. // Basic Linear Algebra Subprograms for Fortran Usage,
  1064. // Algorithm 539,
  1065. // ACM Transactions on Mathematical Software,
  1066. // Volume 5, Number 3, September 1979, pages 308-323.
  1067. //
  1068. // Parameters:
  1069. //
  1070. // Input, int N, the number of entries in the vector.
  1071. //
  1072. // Input, double X[*], the vector to be examined.
  1073. //
  1074. // Input, int INCX, the increment between successive entries of SX.
  1075. //
  1076. // Output, int IDAMAX, the index of the element of maximum
  1077. // absolute value.
  1078. //
  1079. {
  1080. double dmax;
  1081. int i;
  1082. int ix;
  1083. int value;
  1084.  
  1085. value = 0;
  1086.  
  1087. if ( n < 1 || incx <= 0 )
  1088. {
  1089. return value;
  1090. }
  1091.  
  1092. value = 1;
  1093.  
  1094. if ( n == 1 )
  1095. {
  1096. return value;
  1097. }
  1098.  
  1099. if ( incx == 1 )
  1100. {
  1101. dmax = r8_abs ( dx[0] );
  1102.  
  1103. for ( i = 1; i < n; i++ )
  1104. {
  1105. if ( dmax < r8_abs ( dx[i] ) )
  1106. {
  1107. value = i + 1;
  1108. dmax = r8_abs ( dx[i] );
  1109. }
  1110. }
  1111. }
  1112. else
  1113. {
  1114. ix = 0;
  1115. dmax = r8_abs ( dx[0] );
  1116. ix = ix + incx;
  1117.  
  1118. for ( i = 1; i < n; i++ )
  1119. {
  1120. if ( dmax < r8_abs ( dx[ix] ) )
  1121. {
  1122. value = i + 1;
  1123. dmax = r8_abs ( dx[ix] );
  1124. }
  1125. ix = ix + incx;
  1126. }
  1127. }
  1128.  
  1129. return value;
  1130. }
  1131. //****************************************************************************80
  1132.  
  1133. void timestamp ( void )
  1134.  
  1135. //****************************************************************************80
  1136. //
  1137. // Purpose:
  1138. //
  1139. // TIMESTAMP prints the current YMDHMS date as a time stamp.
  1140. //
  1141. // Example:
  1142. //
  1143. // May 31 2001 09:45:54 AM
  1144. //
  1145. // Modified:
  1146. //
  1147. // 24 September 2003
  1148. //
  1149. // Author:
  1150. //
  1151. // John Burkardt
  1152. //
  1153. // Parameters:
  1154. //
  1155. // None
  1156. //
  1157. {
  1158. # define TIME_SIZE 40
  1159.  
  1160. static char time_buffer[TIME_SIZE];
  1161. const struct tm *tm;
  1162. size_t len;
  1163. time_t now;
  1164.  
  1165. now = time ( NULL );
  1166. tm = localtime ( &now );
  1167.  
  1168. len = strftime ( time_buffer, TIME_SIZE, "%d %B %Y %I:%M:%S %p", tm );
  1169.  
  1170. cout << time_buffer << "\n";
  1171.  
  1172. return;
  1173. # undef TIME_SIZE
  1174. }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement