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.

zlat2c.f 5.1 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180
  1. *> \brief \b ZLAT2C converts a double complex triangular matrix to a complex triangular matrix.
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download ZLAT2C + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlat2c.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlat2c.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlat2c.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE ZLAT2C( UPLO, N, A, LDA, SA, LDSA, INFO )
  22. *
  23. * .. Scalar Arguments ..
  24. * CHARACTER UPLO
  25. * INTEGER INFO, LDA, LDSA, N
  26. * ..
  27. * .. Array Arguments ..
  28. * COMPLEX SA( LDSA, * )
  29. * COMPLEX*16 A( LDA, * )
  30. * ..
  31. *
  32. *
  33. *> \par Purpose:
  34. * =============
  35. *>
  36. *> \verbatim
  37. *>
  38. *> ZLAT2C converts a COMPLEX*16 triangular matrix, SA, to a COMPLEX
  39. *> triangular matrix, A.
  40. *>
  41. *> RMAX is the overflow for the SINGLE PRECISION arithmetic
  42. *> ZLAT2C checks that all the entries of A are between -RMAX and
  43. *> RMAX. If not the conversion is aborted and a flag is raised.
  44. *>
  45. *> This is an auxiliary routine so there is no argument checking.
  46. *> \endverbatim
  47. *
  48. * Arguments:
  49. * ==========
  50. *
  51. *> \param[in] UPLO
  52. *> \verbatim
  53. *> UPLO is CHARACTER*1
  54. *> = 'U': A is upper triangular;
  55. *> = 'L': A is lower triangular.
  56. *> \endverbatim
  57. *>
  58. *> \param[in] N
  59. *> \verbatim
  60. *> N is INTEGER
  61. *> The number of rows and columns of the matrix A. N >= 0.
  62. *> \endverbatim
  63. *>
  64. *> \param[in] A
  65. *> \verbatim
  66. *> A is COMPLEX*16 array, dimension (LDA,N)
  67. *> On entry, the N-by-N triangular coefficient matrix A.
  68. *> \endverbatim
  69. *>
  70. *> \param[in] LDA
  71. *> \verbatim
  72. *> LDA is INTEGER
  73. *> The leading dimension of the array A. LDA >= max(1,N).
  74. *> \endverbatim
  75. *>
  76. *> \param[out] SA
  77. *> \verbatim
  78. *> SA is COMPLEX array, dimension (LDSA,N)
  79. *> Only the UPLO part of SA is referenced. On exit, if INFO=0,
  80. *> the N-by-N coefficient matrix SA; if INFO>0, the content of
  81. *> the UPLO part of SA is unspecified.
  82. *> \endverbatim
  83. *>
  84. *> \param[in] LDSA
  85. *> \verbatim
  86. *> LDSA is INTEGER
  87. *> The leading dimension of the array SA. LDSA >= max(1,M).
  88. *> \endverbatim
  89. *>
  90. *> \param[out] INFO
  91. *> \verbatim
  92. *> INFO is INTEGER
  93. *> = 0: successful exit.
  94. *> = 1: an entry of the matrix A is greater than the SINGLE
  95. *> PRECISION overflow threshold, in this case, the content
  96. *> of the UPLO part of SA in exit is unspecified.
  97. *> \endverbatim
  98. *
  99. * Authors:
  100. * ========
  101. *
  102. *> \author Univ. of Tennessee
  103. *> \author Univ. of California Berkeley
  104. *> \author Univ. of Colorado Denver
  105. *> \author NAG Ltd.
  106. *
  107. *> \date December 2016
  108. *
  109. *> \ingroup complex16OTHERauxiliary
  110. *
  111. * =====================================================================
  112. SUBROUTINE ZLAT2C( UPLO, N, A, LDA, SA, LDSA, INFO )
  113. *
  114. * -- LAPACK auxiliary routine (version 3.7.0) --
  115. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  116. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  117. * December 2016
  118. *
  119. * .. Scalar Arguments ..
  120. CHARACTER UPLO
  121. INTEGER INFO, LDA, LDSA, N
  122. * ..
  123. * .. Array Arguments ..
  124. COMPLEX SA( LDSA, * )
  125. COMPLEX*16 A( LDA, * )
  126. * ..
  127. *
  128. * =====================================================================
  129. *
  130. * .. Local Scalars ..
  131. INTEGER I, J
  132. DOUBLE PRECISION RMAX
  133. LOGICAL UPPER
  134. * ..
  135. * .. Intrinsic Functions ..
  136. INTRINSIC DBLE, DIMAG
  137. * ..
  138. * .. External Functions ..
  139. REAL SLAMCH
  140. LOGICAL LSAME
  141. EXTERNAL SLAMCH, LSAME
  142. * ..
  143. * .. Executable Statements ..
  144. *
  145. RMAX = SLAMCH( 'O' )
  146. UPPER = LSAME( UPLO, 'U' )
  147. IF( UPPER ) THEN
  148. DO 20 J = 1, N
  149. DO 10 I = 1, J
  150. IF( ( DBLE( A( I, J ) ).LT.-RMAX ) .OR.
  151. $ ( DBLE( A( I, J ) ).GT.RMAX ) .OR.
  152. $ ( DIMAG( A( I, J ) ).LT.-RMAX ) .OR.
  153. $ ( DIMAG( A( I, J ) ).GT.RMAX ) ) THEN
  154. INFO = 1
  155. GO TO 50
  156. END IF
  157. SA( I, J ) = A( I, J )
  158. 10 CONTINUE
  159. 20 CONTINUE
  160. ELSE
  161. DO 40 J = 1, N
  162. DO 30 I = J, N
  163. IF( ( DBLE( A( I, J ) ).LT.-RMAX ) .OR.
  164. $ ( DBLE( A( I, J ) ).GT.RMAX ) .OR.
  165. $ ( DIMAG( A( I, J ) ).LT.-RMAX ) .OR.
  166. $ ( DIMAG( A( I, J ) ).GT.RMAX ) ) THEN
  167. INFO = 1
  168. GO TO 50
  169. END IF
  170. SA( I, J ) = A( I, J )
  171. 30 CONTINUE
  172. 40 CONTINUE
  173. END IF
  174. 50 CONTINUE
  175. *
  176. RETURN
  177. *
  178. * End of ZLAT2C
  179. *
  180. END