Télécharger dgebak.eso

Retour à la liste

Numérotation des lignes :

dgebak
  1. C DGEBAK SOURCE FANDEUR 22/05/02 21:15:04 11359
  2. *> \brief \b DGEBAK
  3. *
  4. * =========== DOCUMENTATION ===========
  5. *
  6. * Online html documentation available at
  7. * http://www.netlib.org/lapack/explore-html/
  8. *
  9. *> \htmlonly
  10. *> Download DGEBAK + dependencies
  11. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgebak.f">
  12. *> [TGZ]</a>
  13. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgebak.f">
  14. *> [ZIP]</a>
  15. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgebak.f">
  16. *> [TXT]</a>
  17. *> \endhtmlonly
  18. *
  19. * Definition:
  20. * ===========
  21. *
  22. * SUBROUTINE DGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
  23. * INFO )
  24. *
  25. * .. Scalar Arguments ..
  26. * CHARACTER JOB, SIDE
  27. * INTEGER IHI, ILO, INFO, LDV, M, N
  28. * ..
  29. * .. Array Arguments ..
  30. * REAL*8 SCALE( * ), V( LDV, * )
  31. * ..
  32. *
  33. *
  34. *> \par Purpose:
  35. * =============
  36. *>
  37. *> \verbatim
  38. *>
  39. *> DGEBAK forms the right or left eigenvectors of a real general matrix
  40. *> by backward transformation on the computed eigenvectors of the
  41. *> balanced matrix output by DGEBAL.
  42. *> \endverbatim
  43. *
  44. * Arguments:
  45. * ==========
  46. *
  47. *> \param[in] JOB
  48. *> \verbatim
  49. *> JOB is CHARACTER*1
  50. *> Specifies the type of backward transformation required:
  51. *> = 'N', do nothing, return immediately;
  52. *> = 'P', do backward transformation for permutation only;
  53. *> = 'S', do backward transformation for scaling only;
  54. *> = 'B', do backward transformations for both permutation and
  55. *> scaling.
  56. *> JOB must be the same as the argument JOB supplied to DGEBAL.
  57. *> \endverbatim
  58. *>
  59. *> \param[in] SIDE
  60. *> \verbatim
  61. *> SIDE is CHARACTER*1
  62. *> = 'R': V contains right eigenvectors;
  63. *> = 'L': V contains left eigenvectors.
  64. *> \endverbatim
  65. *>
  66. *> \param[in] N
  67. *> \verbatim
  68. *> N is INTEGER
  69. *> The number of rows of the matrix V. N >= 0.
  70. *> \endverbatim
  71. *>
  72. *> \param[in] ILO
  73. *> \verbatim
  74. *> ILO is INTEGER
  75. *> \endverbatim
  76. *>
  77. *> \param[in] IHI
  78. *> \verbatim
  79. *> IHI is INTEGER
  80. *> The integers ILO and IHI determined by DGEBAL.
  81. *> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
  82. *> \endverbatim
  83. *>
  84. *> \param[in] SCALE
  85. *> \verbatim
  86. *> SCALE is REAL*8 array, dimension (N)
  87. *> Details of the permutation and scaling factors, as returned
  88. *> by DGEBAL.
  89. *> \endverbatim
  90. *>
  91. *> \param[in] M
  92. *> \verbatim
  93. *> M is INTEGER
  94. *> The number of columns of the matrix V. M >= 0.
  95. *> \endverbatim
  96. *>
  97. *> \param[in,out] V
  98. *> \verbatim
  99. *> V is REAL*8 array, dimension (LDV,M)
  100. *> On entry, the matrix of right or left eigenvectors to be
  101. *> transformed, as returned by DHSEIN or DTREVC.
  102. *> On exit, V is overwritten by the transformed eigenvectors.
  103. *> \endverbatim
  104. *>
  105. *> \param[in] LDV
  106. *> \verbatim
  107. *> LDV is INTEGER
  108. *> The leading dimension of the array V. LDV >= max(1,N).
  109. *> \endverbatim
  110. *>
  111. *> \param[out] INFO
  112. *> \verbatim
  113. *> INFO is INTEGER
  114. *> = 0: successful exit
  115. *> < 0: if INFO = -i, the i-th argument had an illegal value.
  116. *> \endverbatim
  117. *
  118. * Authors:
  119. * ========
  120. *
  121. *> \author Univ. of Tennessee
  122. *> \author Univ. of California Berkeley
  123. *> \author Univ. of Colorado Denver
  124. *> \author NAG Ltd.
  125. *
  126. *> \date December 2016
  127. *
  128. *> \ingroup doubleGEcomputational
  129. *
  130. * =====================================================================
  131. SUBROUTINE DGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
  132. $ INFO )
  133. *
  134. * -- LAPACK computational routine (version 3.7.0) --
  135. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  136. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  137. * December 2016
  138. IMPLICIT INTEGER(I-N)
  139. IMPLICIT REAL*8(A-H,O-Z)
  140.  
  141. *
  142. * .. Scalar Arguments ..
  143. CHARACTER JOB, SIDE
  144. INTEGER IHI, ILO, INFO, LDV, M, N
  145. * ..
  146. * .. Array Arguments ..
  147. REAL*8 SCALE( * ), V( LDV, * )
  148. * ..
  149. *
  150. * =====================================================================
  151. *
  152. * .. Parameters ..
  153. REAL*8 ONE
  154. PARAMETER ( ONE = 1.0D+0 )
  155. * ..
  156. * .. Local Scalars ..
  157. LOGICAL LEFTV, RIGHTV
  158. INTEGER I, II, K
  159. REAL*8 S
  160. * ..
  161. * .. External Functions ..
  162. LOGICAL LSAME
  163. EXTERNAL LSAME
  164. * ..
  165. * .. External Subroutines ..
  166. EXTERNAL DSCAL, DSWAP, XERBLA
  167. * ..
  168. * .. Intrinsic Functions ..
  169. * INTRINSIC MAX, MIN
  170. * ..
  171. * .. Executable Statements ..
  172. *
  173. * Decode and Test the input parameters
  174. *
  175. RIGHTV = LSAME( SIDE, 'R' )
  176. LEFTV = LSAME( SIDE, 'L' )
  177. *
  178. INFO = 0
  179. IF( .NOT.LSAME( JOB, 'N' ) .AND.
  180. $ .NOT.LSAME( JOB, 'P' ) .AND.
  181. $ .NOT.LSAME( JOB, 'S' ) .AND.
  182. $ .NOT.LSAME( JOB, 'B' ) ) THEN
  183. INFO = -1
  184. ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
  185. INFO = -2
  186. ELSE IF( N.LT.0 ) THEN
  187. INFO = -3
  188. ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
  189. INFO = -4
  190. ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
  191. INFO = -5
  192. ELSE IF( M.LT.0 ) THEN
  193. INFO = -7
  194. ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
  195. INFO = -9
  196. END IF
  197. IF( INFO.NE.0 ) THEN
  198. CALL XERBLA( 'DGEBAK', -INFO )
  199. RETURN
  200. END IF
  201. *
  202. * Quick return if possible
  203. *
  204. IF( N.EQ.0 )
  205. $ RETURN
  206. IF( M.EQ.0 )
  207. $ RETURN
  208. IF( LSAME( JOB, 'N' ) )
  209. $ RETURN
  210. *
  211. IF( ILO.EQ.IHI )
  212. $ GO TO 30
  213. *
  214. * Backward balance
  215. *
  216. IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
  217. *
  218. IF( RIGHTV ) THEN
  219. DO 10 I = ILO, IHI
  220. S = SCALE( I )
  221. CALL DSCAL( M, S, V( I, 1 ), LDV )
  222. 10 CONTINUE
  223. END IF
  224. *
  225. IF( LEFTV ) THEN
  226. DO 20 I = ILO, IHI
  227. S = ONE / SCALE( I )
  228. CALL DSCAL( M, S, V( I, 1 ), LDV )
  229. 20 CONTINUE
  230. END IF
  231. *
  232. END IF
  233. *
  234. * Backward permutation
  235. *
  236. * For I = ILO-1 step -1 until 1,
  237. * IHI+1 step 1 until N do --
  238. *
  239. 30 CONTINUE
  240. IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
  241. IF( RIGHTV ) THEN
  242. DO 40 II = 1, N
  243. I = II
  244. IF( I.GE.ILO .AND. I.LE.IHI )
  245. $ GO TO 40
  246. IF( I.LT.ILO )
  247. $ I = ILO - II
  248. cpoureviterwarning K = SCALE( I )
  249. K = INT(SCALE( I ))
  250. IF( K.EQ.I )
  251. $ GO TO 40
  252. CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
  253. 40 CONTINUE
  254. END IF
  255. *
  256. IF( LEFTV ) THEN
  257. DO 50 II = 1, N
  258. I = II
  259. IF( I.GE.ILO .AND. I.LE.IHI )
  260. $ GO TO 50
  261. IF( I.LT.ILO )
  262. $ I = ILO - II
  263. cpoureviterwarning K = SCALE( I )
  264. K = INT(SCALE( I ))
  265. IF( K.EQ.I )
  266. $ GO TO 50
  267. CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
  268. 50 CONTINUE
  269. END IF
  270. END IF
  271. *
  272. RETURN
  273. *
  274. * End of DGEBAK
  275. *
  276. END
  277.  
  278.  
  279.  
  280.  

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