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.

zggbak.f 8.4 kB

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