Télécharger dlasr.eso

Retour à la liste

Numérotation des lignes :

  1. C DLASR SOURCE BP208322 15/10/13 21:15:39 8670
  2. *> \brief \b DLASR applies a sequence of plane rotations to a general rectangular matrix.
  3. *
  4. * =========== DOCUMENTATION ===========
  5. *
  6. * Online html documentation available at
  7. * http://www.netlib.org/lapack/explore-html/
  8. *
  9. *> \htmlonly
  10. *> Download DLASR + dependencies
  11. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasr.f">
  12. *> [TGZ]</a>
  13. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasr.f">
  14. *> [ZIP]</a>
  15. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasr.f">
  16. *> [TXT]</a>
  17. *> \endhtmlonly
  18. *
  19. * Definition:
  20. * ===========
  21. *
  22. * SUBROUTINE DLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )
  23. *
  24. * .. Scalar Arguments ..
  25. * CHARACTER DIRECT, PIVOT, SIDE
  26. * INTEGER LDA, M, N
  27. * ..
  28. * .. Array Arguments ..
  29. * REAL*8 A( LDA, * ), C( * ), S( * )
  30. * ..
  31. *
  32. *
  33. *> \par Purpose:
  34. * =============
  35. *>
  36. *> \verbatim
  37. *>
  38. *> DLASR applies a sequence of plane rotations to a real matrix A,
  39. *> from either the left or the right.
  40. *>
  41. *> When SIDE = 'L', the transformation takes the form
  42. *>
  43. *> A := P*A
  44. *>
  45. *> and when SIDE = 'R', the transformation takes the form
  46. *>
  47. *> A := A*P**T
  48. *>
  49. *> where P is an orthogonal matrix consisting of a sequence of z plane
  50. *> rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R',
  51. *> and P**T is the transpose of P.
  52. *>
  53. *> When DIRECT = 'F' (Forward sequence), then
  54. *>
  55. *> P = P(z-1) * ... * P(2) * P(1)
  56. *>
  57. *> and when DIRECT = 'B' (Backward sequence), then
  58. *>
  59. *> P = P(1) * P(2) * ... * P(z-1)
  60. *>
  61. *> where P(k) is a plane rotation matrix defined by the 2-by-2 rotation
  62. *>
  63. *> R(k) = ( c(k) s(k) )
  64. *> = ( -s(k) c(k) ).
  65. *>
  66. *> When PIVOT = 'V' (Variable pivot), the rotation is performed
  67. *> for the plane (k,k+1), i.e., P(k) has the form
  68. *>
  69. *> P(k) = ( 1 )
  70. *> ( ... )
  71. *> ( 1 )
  72. *> ( c(k) s(k) )
  73. *> ( -s(k) c(k) )
  74. *> ( 1 )
  75. *> ( ... )
  76. *> ( 1 )
  77. *>
  78. *> where R(k) appears as a rank-2 modification to the identity matrix in
  79. *> rows and columns k and k+1.
  80. *>
  81. *> When PIVOT = 'T' (Top pivot), the rotation is performed for the
  82. *> plane (1,k+1), so P(k) has the form
  83. *>
  84. *> P(k) = ( c(k) s(k) )
  85. *> ( 1 )
  86. *> ( ... )
  87. *> ( 1 )
  88. *> ( -s(k) c(k) )
  89. *> ( 1 )
  90. *> ( ... )
  91. *> ( 1 )
  92. *>
  93. *> where R(k) appears in rows and columns 1 and k+1.
  94. *>
  95. *> Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is
  96. *> performed for the plane (k,z), giving P(k) the form
  97. *>
  98. *> P(k) = ( 1 )
  99. *> ( ... )
  100. *> ( 1 )
  101. *> ( c(k) s(k) )
  102. *> ( 1 )
  103. *> ( ... )
  104. *> ( 1 )
  105. *> ( -s(k) c(k) )
  106. *>
  107. *> where R(k) appears in rows and columns k and z. The rotations are
  108. *> performed without ever forming P(k) explicitly.
  109. *> \endverbatim
  110. *
  111. * Arguments:
  112. * ==========
  113. *
  114. *> \param[in] SIDE
  115. *> \verbatim
  116. *> SIDE is CHARACTER*1
  117. *> Specifies whether the plane rotation matrix P is applied to
  118. *> A on the left or the right.
  119. *> = 'L': Left, compute A := P*A
  120. *> = 'R': Right, compute A:= A*P**T
  121. *> \endverbatim
  122. *>
  123. *> \param[in] PIVOT
  124. *> \verbatim
  125. *> PIVOT is CHARACTER*1
  126. *> Specifies the plane for which P(k) is a plane rotation
  127. *> matrix.
  128. *> = 'V': Variable pivot, the plane (k,k+1)
  129. *> = 'T': Top pivot, the plane (1,k+1)
  130. *> = 'B': Bottom pivot, the plane (k,z)
  131. *> \endverbatim
  132. *>
  133. *> \param[in] DIRECT
  134. *> \verbatim
  135. *> DIRECT is CHARACTER*1
  136. *> Specifies whether P is a forward or backward sequence of
  137. *> plane rotations.
  138. *> = 'F': Forward, P = P(z-1)*...*P(2)*P(1)
  139. *> = 'B': Backward, P = P(1)*P(2)*...*P(z-1)
  140. *> \endverbatim
  141. *>
  142. *> \param[in] M
  143. *> \verbatim
  144. *> M is INTEGER
  145. *> The number of rows of the matrix A. If m <= 1, an immediate
  146. *> return is effected.
  147. *> \endverbatim
  148. *>
  149. *> \param[in] N
  150. *> \verbatim
  151. *> N is INTEGER
  152. *> The number of columns of the matrix A. If n <= 1, an
  153. *> immediate return is effected.
  154. *> \endverbatim
  155. *>
  156. *> \param[in] C
  157. *> \verbatim
  158. *> C is DOUBLE PRECISION array, dimension
  159. *> (M-1) if SIDE = 'L'
  160. *> (N-1) if SIDE = 'R'
  161. *> The cosines c(k) of the plane rotations.
  162. *> \endverbatim
  163. *>
  164. *> \param[in] S
  165. *> \verbatim
  166. *> S is DOUBLE PRECISION array, dimension
  167. *> (M-1) if SIDE = 'L'
  168. *> (N-1) if SIDE = 'R'
  169. *> The sines s(k) of the plane rotations. The 2-by-2 plane
  170. *> rotation part of the matrix P(k), R(k), has the form
  171. *> R(k) = ( c(k) s(k) )
  172. *> ( -s(k) c(k) ).
  173. *> \endverbatim
  174. *>
  175. *> \param[in,out] A
  176. *> \verbatim
  177. *> A is DOUBLE PRECISION array, dimension (LDA,N)
  178. *> The M-by-N matrix A. On exit, A is overwritten by P*A if
  179. *> SIDE = 'R' or by A*P**T if SIDE = 'L'.
  180. *> \endverbatim
  181. *>
  182. *> \param[in] LDA
  183. *> \verbatim
  184. *> LDA is INTEGER
  185. *> The leading dimension of the array A. LDA >= max(1,M).
  186. *> \endverbatim
  187. *
  188. * Authors:
  189. * ========
  190. *
  191. *> \author Univ. of Tennessee
  192. *> \author Univ. of California Berkeley
  193. *> \author Univ. of Colorado Denver
  194. *> \author NAG Ltd.
  195. *
  196. *> \date September 2012
  197. *
  198. *> \ingroup auxOTHERauxiliary
  199. *
  200. * =====================================================================
  201. SUBROUTINE DLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )
  202. *
  203. * -- LAPACK auxiliary routine (version 3.4.2) --
  204. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  205. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  206. * September 2012
  207. *
  208. * .. Scalar Arguments ..
  209. CHARACTER DIRECT, PIVOT, SIDE
  210. INTEGER LDA, M, N
  211. * ..
  212. * .. Array Arguments ..
  213. REAL*8 A( LDA, * ), C( * ), S( * )
  214. * ..
  215. *
  216. * =====================================================================
  217. *
  218. * .. Parameters ..
  219. REAL*8 ONE, ZERO
  220. PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  221. * ..
  222. * .. Local Scalars ..
  223. INTEGER I, INFO, J
  224. REAL*8 CTEMP, STEMP, TEMP
  225. * ..
  226. * .. External Functions ..
  227. LOGICAL LSAME
  228. EXTERNAL LSAME
  229. * ..
  230. * .. External Subroutines ..
  231. EXTERNAL XERBLA
  232. * ..
  233. ** .. Intrinsic Functions ..
  234. * INTRINSIC MAX
  235. ** ..
  236. ** .. Executable Statements ..
  237. *
  238. * Test the input parameters
  239. *
  240. INFO = 0
  241. IF( .NOT.( LSAME( SIDE, 'L' ) .OR. LSAME( SIDE, 'R' ) ) ) THEN
  242. INFO = 1
  243. ELSE IF( .NOT.( LSAME( PIVOT, 'V' ) .OR. LSAME( PIVOT,
  244. $ 'T' ) .OR. LSAME( PIVOT, 'B' ) ) ) THEN
  245. INFO = 2
  246. ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR. LSAME( DIRECT, 'B' ) ) )
  247. $ THEN
  248. INFO = 3
  249. ELSE IF( M.LT.0 ) THEN
  250. INFO = 4
  251. ELSE IF( N.LT.0 ) THEN
  252. INFO = 5
  253. ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
  254. INFO = 9
  255. END IF
  256. IF( INFO.NE.0 ) THEN
  257. CALL XERBLA( 'DLASR ', INFO )
  258. RETURN
  259. END IF
  260. *
  261. * Quick return if possible
  262. *
  263. IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )
  264. $ RETURN
  265. IF( LSAME( SIDE, 'L' ) ) THEN
  266. *
  267. * Form P * A
  268. *
  269. IF( LSAME( PIVOT, 'V' ) ) THEN
  270. IF( LSAME( DIRECT, 'F' ) ) THEN
  271. DO 20 J = 1, M - 1
  272. CTEMP = C( J )
  273. STEMP = S( J )
  274. IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
  275. DO 10 I = 1, N
  276. TEMP = A( J+1, I )
  277. A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I )
  278. A( J, I ) = STEMP*TEMP + CTEMP*A( J, I )
  279. 10 CONTINUE
  280. END IF
  281. 20 CONTINUE
  282. ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
  283. DO 40 J = M - 1, 1, -1
  284. CTEMP = C( J )
  285. STEMP = S( J )
  286. IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
  287. DO 30 I = 1, N
  288. TEMP = A( J+1, I )
  289. A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I )
  290. A( J, I ) = STEMP*TEMP + CTEMP*A( J, I )
  291. 30 CONTINUE
  292. END IF
  293. 40 CONTINUE
  294. END IF
  295. ELSE IF( LSAME( PIVOT, 'T' ) ) THEN
  296. IF( LSAME( DIRECT, 'F' ) ) THEN
  297. DO 60 J = 2, M
  298. CTEMP = C( J-1 )
  299. STEMP = S( J-1 )
  300. IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
  301. DO 50 I = 1, N
  302. TEMP = A( J, I )
  303. A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I )
  304. A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I )
  305. 50 CONTINUE
  306. END IF
  307. 60 CONTINUE
  308. ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
  309. DO 80 J = M, 2, -1
  310. CTEMP = C( J-1 )
  311. STEMP = S( J-1 )
  312. IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
  313. DO 70 I = 1, N
  314. TEMP = A( J, I )
  315. A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I )
  316. A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I )
  317. 70 CONTINUE
  318. END IF
  319. 80 CONTINUE
  320. END IF
  321. ELSE IF( LSAME( PIVOT, 'B' ) ) THEN
  322. IF( LSAME( DIRECT, 'F' ) ) THEN
  323. DO 100 J = 1, M - 1
  324. CTEMP = C( J )
  325. STEMP = S( J )
  326. IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
  327. DO 90 I = 1, N
  328. TEMP = A( J, I )
  329. A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP
  330. A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP
  331. 90 CONTINUE
  332. END IF
  333. 100 CONTINUE
  334. ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
  335. DO 120 J = M - 1, 1, -1
  336. CTEMP = C( J )
  337. STEMP = S( J )
  338. IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
  339. DO 110 I = 1, N
  340. TEMP = A( J, I )
  341. A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP
  342. A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP
  343. 110 CONTINUE
  344. END IF
  345. 120 CONTINUE
  346. END IF
  347. END IF
  348. ELSE IF( LSAME( SIDE, 'R' ) ) THEN
  349. *
  350. * Form A * P**T
  351. *
  352. IF( LSAME( PIVOT, 'V' ) ) THEN
  353. IF( LSAME( DIRECT, 'F' ) ) THEN
  354. DO 140 J = 1, N - 1
  355. CTEMP = C( J )
  356. STEMP = S( J )
  357. IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
  358. DO 130 I = 1, M
  359. TEMP = A( I, J+1 )
  360. A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J )
  361. A( I, J ) = STEMP*TEMP + CTEMP*A( I, J )
  362. 130 CONTINUE
  363. END IF
  364. 140 CONTINUE
  365. ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
  366. DO 160 J = N - 1, 1, -1
  367. CTEMP = C( J )
  368. STEMP = S( J )
  369. IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
  370. DO 150 I = 1, M
  371. TEMP = A( I, J+1 )
  372. A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J )
  373. A( I, J ) = STEMP*TEMP + CTEMP*A( I, J )
  374. 150 CONTINUE
  375. END IF
  376. 160 CONTINUE
  377. END IF
  378. ELSE IF( LSAME( PIVOT, 'T' ) ) THEN
  379. IF( LSAME( DIRECT, 'F' ) ) THEN
  380. DO 180 J = 2, N
  381. CTEMP = C( J-1 )
  382. STEMP = S( J-1 )
  383. IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
  384. DO 170 I = 1, M
  385. TEMP = A( I, J )
  386. A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 )
  387. A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 )
  388. 170 CONTINUE
  389. END IF
  390. 180 CONTINUE
  391. ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
  392. DO 200 J = N, 2, -1
  393. CTEMP = C( J-1 )
  394. STEMP = S( J-1 )
  395. IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
  396. DO 190 I = 1, M
  397. TEMP = A( I, J )
  398. A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 )
  399. A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 )
  400. 190 CONTINUE
  401. END IF
  402. 200 CONTINUE
  403. END IF
  404. ELSE IF( LSAME( PIVOT, 'B' ) ) THEN
  405. IF( LSAME( DIRECT, 'F' ) ) THEN
  406. DO 220 J = 1, N - 1
  407. CTEMP = C( J )
  408. STEMP = S( J )
  409. IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
  410. DO 210 I = 1, M
  411. TEMP = A( I, J )
  412. A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP
  413. A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP
  414. 210 CONTINUE
  415. END IF
  416. 220 CONTINUE
  417. ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
  418. DO 240 J = N - 1, 1, -1
  419. CTEMP = C( J )
  420. STEMP = S( J )
  421. IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
  422. DO 230 I = 1, M
  423. TEMP = A( I, J )
  424. A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP
  425. A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP
  426. 230 CONTINUE
  427. END IF
  428. 240 CONTINUE
  429. END IF
  430. END IF
  431. END IF
  432. *
  433. RETURN
  434. *
  435. * End of DLASR
  436. *
  437. END
  438.  
  439.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales