Télécharger dlacn2.eso

Retour à la liste

Numérotation des lignes :

  1. C DLACN2 SOURCE BP208322 15/10/13 21:15:23 8670
  2. *> \brief \b DLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products.
  3. *
  4. * =========== DOCUMENTATION ===========
  5. *
  6. * Online html documentation available at
  7. * http://www.netlib.org/lapack/explore-html/
  8. *
  9. *> \htmlonly
  10. *> Download DLACN2 + dependencies
  11. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlacn2.f">
  12. *> [TGZ]</a>
  13. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlacn2.f">
  14. *> [ZIP]</a>
  15. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlacn2.f">
  16. *> [TXT]</a>
  17. *> \endhtmlonly
  18. *
  19. * Definition:
  20. * ===========
  21. *
  22. * SUBROUTINE DLACN2( N, V, X, ISGN, EST, KASE, ISAVE )
  23. *
  24. * .. Scalar Arguments ..
  25. * INTEGER KASE, N
  26. * REAL*8 EST
  27. * ..
  28. * .. Array Arguments ..
  29. * INTEGER ISGN( * ), ISAVE( 3 )
  30. * REAL*8 V( * ), X( * )
  31. * ..
  32. *
  33. *
  34. *> \par Purpose:
  35. * =============
  36. *>
  37. *> \verbatim
  38. *>
  39. *> DLACN2 estimates the 1-norm of a square, real matrix A.
  40. *> Reverse communication is used for evaluating matrix-vector products.
  41. *> \endverbatim
  42. *
  43. * Arguments:
  44. * ==========
  45. *
  46. *> \param[in] N
  47. *> \verbatim
  48. *> N is INTEGER
  49. *> The order of the matrix. N >= 1.
  50. *> \endverbatim
  51. *>
  52. *> \param[out] V
  53. *> \verbatim
  54. *> V is DOUBLE PRECISION array, dimension (N)
  55. *> On the final return, V = A*W, where EST = norm(V)/norm(W)
  56. *> (W is not returned).
  57. *> \endverbatim
  58. *>
  59. *> \param[in,out] X
  60. *> \verbatim
  61. *> X is DOUBLE PRECISION array, dimension (N)
  62. *> On an intermediate return, X should be overwritten by
  63. *> A * X, if KASE=1,
  64. *> A**T * X, if KASE=2,
  65. *> and DLACN2 must be re-called with all the other parameters
  66. *> unchanged.
  67. *> \endverbatim
  68. *>
  69. *> \param[out] ISGN
  70. *> \verbatim
  71. *> ISGN is INTEGER array, dimension (N)
  72. *> \endverbatim
  73. *>
  74. *> \param[in,out] EST
  75. *> \verbatim
  76. *> EST is DOUBLE PRECISION
  77. *> On entry with KASE = 1 or 2 and ISAVE(1) = 3, EST should be
  78. *> unchanged from the previous call to DLACN2.
  79. *> On exit, EST is an estimate (a lower bound) for norm(A).
  80. *> \endverbatim
  81. *>
  82. *> \param[in,out] KASE
  83. *> \verbatim
  84. *> KASE is INTEGER
  85. *> On the initial call to DLACN2, KASE should be 0.
  86. *> On an intermediate return, KASE will be 1 or 2, indicating
  87. *> whether X should be overwritten by A * X or A**T * X.
  88. *> On the final return from DLACN2, KASE will again be 0.
  89. *> \endverbatim
  90. *>
  91. *> \param[in,out] ISAVE
  92. *> \verbatim
  93. *> ISAVE is INTEGER array, dimension (3)
  94. *> ISAVE is used to save variables between calls to DLACN2
  95. *> \endverbatim
  96. *
  97. * Authors:
  98. * ========
  99. *
  100. *> \author Univ. of Tennessee
  101. *> \author Univ. of California Berkeley
  102. *> \author Univ. of Colorado Denver
  103. *> \author NAG Ltd.
  104. *
  105. *> \date September 2012
  106. *
  107. *> \ingroup doubleOTHERauxiliary
  108. *
  109. *> \par Further Details:
  110. * =====================
  111. *>
  112. *> \verbatim
  113. *>
  114. *> Originally named SONEST, dated March 16, 1988.
  115. *>
  116. *> This is a thread safe version of DLACON, which uses the array ISAVE
  117. *> in place of a SAVE statement, as follows:
  118. *>
  119. *> DLACON DLACN2
  120. *> JUMP ISAVE(1)
  121. *> J ISAVE(2)
  122. *> ITER ISAVE(3)
  123. *> \endverbatim
  124. *
  125. *> \par Contributors:
  126. * ==================
  127. *>
  128. *> Nick Higham, University of Manchester
  129. *
  130. *> \par References:
  131. * ================
  132. *>
  133. *> N.J. Higham, "FORTRAN codes for estimating the one-norm of
  134. *> a real or complex matrix, with applications to condition estimation",
  135. *> ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
  136. *>
  137. * =====================================================================
  138. SUBROUTINE DLACN2( N, V, X, ISGN, EST, KASE, ISAVE )
  139. *
  140. * -- LAPACK auxiliary routine (version 3.4.2) --
  141. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  142. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  143. * September 2012
  144. *
  145. * .. Scalar Arguments ..
  146. INTEGER KASE, N
  147. REAL*8 EST
  148. * ..
  149. * .. Array Arguments ..
  150. INTEGER ISGN( * ), ISAVE( 3 )
  151. REAL*8 V( * ), X( * )
  152. * ..
  153. *
  154. * =====================================================================
  155. *
  156. * .. Parameters ..
  157. INTEGER ITMAX
  158. PARAMETER ( ITMAX = 5 )
  159. REAL*8 ZERO, ONE, TWO
  160. PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
  161. * ..
  162. * .. Local Scalars ..
  163. INTEGER I, JLAST
  164. REAL*8 ALTSGN, ESTOLD, TEMP
  165. * ..
  166. * .. External Functions ..
  167. INTEGER IDAMAX
  168. REAL*8 DASUM
  169. EXTERNAL IDAMAX, DASUM
  170. * ..
  171. * .. External Subroutines ..
  172. EXTERNAL DCOPY
  173. * ..
  174. ** .. Intrinsic Functions ..
  175. * INTRINSIC ABS, DBLE, NINT, SIGN
  176. ** ..
  177. ** .. Executable Statements ..
  178. *
  179. IF( KASE.EQ.0 ) THEN
  180. DO 10 I = 1, N
  181. X( I ) = ONE / DBLE( N )
  182. 10 CONTINUE
  183. KASE = 1
  184. ISAVE( 1 ) = 1
  185. RETURN
  186. END IF
  187. *
  188. GO TO ( 20, 40, 70, 110, 140 )ISAVE( 1 )
  189. *
  190. * ................ ENTRY (ISAVE( 1 ) = 1)
  191. * FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X.
  192. *
  193. 20 CONTINUE
  194. IF( N.EQ.1 ) THEN
  195. V( 1 ) = X( 1 )
  196. EST = ABS( V( 1 ) )
  197. * ... QUIT
  198. GO TO 150
  199. END IF
  200. EST = DASUM( N, X, 1 )
  201. *
  202. DO 30 I = 1, N
  203. X( I ) = SIGN( ONE, X( I ) )
  204. ISGN( I ) = NINT( X( I ) )
  205. 30 CONTINUE
  206. KASE = 2
  207. ISAVE( 1 ) = 2
  208. RETURN
  209. *
  210. * ................ ENTRY (ISAVE( 1 ) = 2)
  211. * FIRST ITERATION. X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
  212. *
  213. 40 CONTINUE
  214. ISAVE( 2 ) = IDAMAX( N, X, 1 )
  215. ISAVE( 3 ) = 2
  216. *
  217. * MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
  218. *
  219. 50 CONTINUE
  220. DO 60 I = 1, N
  221. X( I ) = ZERO
  222. 60 CONTINUE
  223. X( ISAVE( 2 ) ) = ONE
  224. KASE = 1
  225. ISAVE( 1 ) = 3
  226. RETURN
  227. *
  228. * ................ ENTRY (ISAVE( 1 ) = 3)
  229. * X HAS BEEN OVERWRITTEN BY A*X.
  230. *
  231. 70 CONTINUE
  232. CALL DCOPY( N, X, 1, V, 1 )
  233. ESTOLD = EST
  234. EST = DASUM( N, V, 1 )
  235. DO 80 I = 1, N
  236. IF( NINT( SIGN( ONE, X( I ) ) ).NE.ISGN( I ) )
  237. $ GO TO 90
  238. 80 CONTINUE
  239. * REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED.
  240. GO TO 120
  241. *
  242. 90 CONTINUE
  243. * TEST FOR CYCLING.
  244. IF( EST.LE.ESTOLD )
  245. $ GO TO 120
  246. *
  247. DO 100 I = 1, N
  248. X( I ) = SIGN( ONE, X( I ) )
  249. ISGN( I ) = NINT( X( I ) )
  250. 100 CONTINUE
  251. KASE = 2
  252. ISAVE( 1 ) = 4
  253. RETURN
  254. *
  255. * ................ ENTRY (ISAVE( 1 ) = 4)
  256. * X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
  257. *
  258. 110 CONTINUE
  259. JLAST = ISAVE( 2 )
  260. ISAVE( 2 ) = IDAMAX( N, X, 1 )
  261. IF( ( X( JLAST ).NE.ABS( X( ISAVE( 2 ) ) ) ) .AND.
  262. $ ( ISAVE( 3 ).LT.ITMAX ) ) THEN
  263. ISAVE( 3 ) = ISAVE( 3 ) + 1
  264. GO TO 50
  265. END IF
  266. *
  267. * ITERATION COMPLETE. FINAL STAGE.
  268. *
  269. 120 CONTINUE
  270. ALTSGN = ONE
  271. DO 130 I = 1, N
  272. X( I ) = ALTSGN*( ONE+DBLE( I-1 ) / DBLE( N-1 ) )
  273. ALTSGN = -ALTSGN
  274. 130 CONTINUE
  275. KASE = 1
  276. ISAVE( 1 ) = 5
  277. RETURN
  278. *
  279. * ................ ENTRY (ISAVE( 1 ) = 5)
  280. * X HAS BEEN OVERWRITTEN BY A*X.
  281. *
  282. 140 CONTINUE
  283. TEMP = TWO*( DASUM( N, X, 1 ) / DBLE( 3*N ) )
  284. IF( TEMP.GT.EST ) THEN
  285. CALL DCOPY( N, X, 1, V, 1 )
  286. EST = TEMP
  287. END IF
  288. *
  289. 150 CONTINUE
  290. KASE = 0
  291. RETURN
  292. *
  293. * End of DLACN2
  294. *
  295. END
  296.  
  297.  

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