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.

slakf2.f 4.1 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188
  1. *> \brief \b SLAKF2
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. * Definition:
  9. * ===========
  10. *
  11. * SUBROUTINE SLAKF2( M, N, A, LDA, B, D, E, Z, LDZ )
  12. *
  13. * .. Scalar Arguments ..
  14. * INTEGER LDA, LDZ, M, N
  15. * ..
  16. * .. Array Arguments ..
  17. * REAL A( LDA, * ), B( LDA, * ), D( LDA, * ),
  18. * $ E( LDA, * ), Z( LDZ, * )
  19. * ..
  20. *
  21. *
  22. *> \par Purpose:
  23. * =============
  24. *>
  25. *> \verbatim
  26. *>
  27. *> Form the 2*M*N by 2*M*N matrix
  28. *>
  29. *> Z = [ kron(In, A) -kron(B', Im) ]
  30. *> [ kron(In, D) -kron(E', Im) ],
  31. *>
  32. *> where In is the identity matrix of size n and X' is the transpose
  33. *> of X. kron(X, Y) is the Kronecker product between the matrices X
  34. *> and Y.
  35. *> \endverbatim
  36. *
  37. * Arguments:
  38. * ==========
  39. *
  40. *> \param[in] M
  41. *> \verbatim
  42. *> M is INTEGER
  43. *> Size of matrix, must be >= 1.
  44. *> \endverbatim
  45. *>
  46. *> \param[in] N
  47. *> \verbatim
  48. *> N is INTEGER
  49. *> Size of matrix, must be >= 1.
  50. *> \endverbatim
  51. *>
  52. *> \param[in] A
  53. *> \verbatim
  54. *> A is REAL, dimension ( LDA, M )
  55. *> The matrix A in the output matrix Z.
  56. *> \endverbatim
  57. *>
  58. *> \param[in] LDA
  59. *> \verbatim
  60. *> LDA is INTEGER
  61. *> The leading dimension of A, B, D, and E. ( LDA >= M+N )
  62. *> \endverbatim
  63. *>
  64. *> \param[in] B
  65. *> \verbatim
  66. *> B is REAL, dimension ( LDA, N )
  67. *> \endverbatim
  68. *>
  69. *> \param[in] D
  70. *> \verbatim
  71. *> D is REAL, dimension ( LDA, M )
  72. *> \endverbatim
  73. *>
  74. *> \param[in] E
  75. *> \verbatim
  76. *> E is REAL, dimension ( LDA, N )
  77. *>
  78. *> The matrices used in forming the output matrix Z.
  79. *> \endverbatim
  80. *>
  81. *> \param[out] Z
  82. *> \verbatim
  83. *> Z is REAL, dimension ( LDZ, 2*M*N )
  84. *> The resultant Kronecker M*N*2 by M*N*2 matrix (see above.)
  85. *> \endverbatim
  86. *>
  87. *> \param[in] LDZ
  88. *> \verbatim
  89. *> LDZ is INTEGER
  90. *> The leading dimension of Z. ( LDZ >= 2*M*N )
  91. *> \endverbatim
  92. *
  93. * Authors:
  94. * ========
  95. *
  96. *> \author Univ. of Tennessee
  97. *> \author Univ. of California Berkeley
  98. *> \author Univ. of Colorado Denver
  99. *> \author NAG Ltd.
  100. *
  101. *> \ingroup real_matgen
  102. *
  103. * =====================================================================
  104. SUBROUTINE SLAKF2( M, N, A, LDA, B, D, E, Z, LDZ )
  105. *
  106. * -- LAPACK computational routine --
  107. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  108. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  109. *
  110. * .. Scalar Arguments ..
  111. INTEGER LDA, LDZ, M, N
  112. * ..
  113. * .. Array Arguments ..
  114. REAL A( LDA, * ), B( LDA, * ), D( LDA, * ),
  115. $ E( LDA, * ), Z( LDZ, * )
  116. * ..
  117. *
  118. * ====================================================================
  119. *
  120. * .. Parameters ..
  121. REAL ZERO
  122. PARAMETER ( ZERO = 0.0E+0 )
  123. * ..
  124. * .. Local Scalars ..
  125. INTEGER I, IK, J, JK, L, MN, MN2
  126. * ..
  127. * .. External Subroutines ..
  128. EXTERNAL SLASET
  129. * ..
  130. * .. Executable Statements ..
  131. *
  132. * Initialize Z
  133. *
  134. MN = M*N
  135. MN2 = 2*MN
  136. CALL SLASET( 'Full', MN2, MN2, ZERO, ZERO, Z, LDZ )
  137. *
  138. IK = 1
  139. DO 50 L = 1, N
  140. *
  141. * form kron(In, A)
  142. *
  143. DO 20 I = 1, M
  144. DO 10 J = 1, M
  145. Z( IK+I-1, IK+J-1 ) = A( I, J )
  146. 10 CONTINUE
  147. 20 CONTINUE
  148. *
  149. * form kron(In, D)
  150. *
  151. DO 40 I = 1, M
  152. DO 30 J = 1, M
  153. Z( IK+MN+I-1, IK+J-1 ) = D( I, J )
  154. 30 CONTINUE
  155. 40 CONTINUE
  156. *
  157. IK = IK + M
  158. 50 CONTINUE
  159. *
  160. IK = 1
  161. DO 90 L = 1, N
  162. JK = MN + 1
  163. *
  164. DO 80 J = 1, N
  165. *
  166. * form -kron(B', Im)
  167. *
  168. DO 60 I = 1, M
  169. Z( IK+I-1, JK+I-1 ) = -B( J, L )
  170. 60 CONTINUE
  171. *
  172. * form -kron(E', Im)
  173. *
  174. DO 70 I = 1, M
  175. Z( IK+MN+I-1, JK+I-1 ) = -E( J, L )
  176. 70 CONTINUE
  177. *
  178. JK = JK + M
  179. 80 CONTINUE
  180. *
  181. IK = IK + M
  182. 90 CONTINUE
  183. *
  184. RETURN
  185. *
  186. * End of SLAKF2
  187. *
  188. END