iladlr.f 2.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121
  1. *> \brief \b ILADLR
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download ILADLR + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/iladlr.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/iladlr.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/iladlr.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * INTEGER FUNCTION ILADLR( M, N, A, LDA )
  22. *
  23. * .. Scalar Arguments ..
  24. * INTEGER M, N, LDA
  25. * ..
  26. * .. Array Arguments ..
  27. * DOUBLE PRECISION A( LDA, * )
  28. * ..
  29. *
  30. *
  31. *> \par Purpose:
  32. * =============
  33. *>
  34. *> \verbatim
  35. *>
  36. *> ILADLR scans A for its last non-zero row.
  37. *> \endverbatim
  38. *
  39. * Arguments:
  40. * ==========
  41. *
  42. *> \param[in] M
  43. *> \verbatim
  44. *> M is INTEGER
  45. *> The number of rows of the matrix A.
  46. *> \endverbatim
  47. *>
  48. *> \param[in] N
  49. *> \verbatim
  50. *> N is INTEGER
  51. *> The number of columns of the matrix A.
  52. *> \endverbatim
  53. *>
  54. *> \param[in] A
  55. *> \verbatim
  56. *> A is DOUBLE PRECISION array, dimension (LDA,N)
  57. *> The m by n matrix A.
  58. *> \endverbatim
  59. *>
  60. *> \param[in] LDA
  61. *> \verbatim
  62. *> LDA is INTEGER
  63. *> The leading dimension of the array A. LDA >= max(1,M).
  64. *> \endverbatim
  65. *
  66. * Authors:
  67. * ========
  68. *
  69. *> \author Univ. of Tennessee
  70. *> \author Univ. of California Berkeley
  71. *> \author Univ. of Colorado Denver
  72. *> \author NAG Ltd.
  73. *
  74. *> \date April 2012
  75. *
  76. *> \ingroup auxOTHERauxiliary
  77. *
  78. * =====================================================================
  79. INTEGER FUNCTION ILADLR( M, N, A, LDA )
  80. *
  81. * -- LAPACK auxiliary routine (version 3.4.1) --
  82. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  83. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  84. * April 2012
  85. *
  86. * .. Scalar Arguments ..
  87. INTEGER M, N, LDA
  88. * ..
  89. * .. Array Arguments ..
  90. DOUBLE PRECISION A( LDA, * )
  91. * ..
  92. *
  93. * =====================================================================
  94. *
  95. * .. Parameters ..
  96. DOUBLE PRECISION ZERO
  97. PARAMETER ( ZERO = 0.0D+0 )
  98. * ..
  99. * .. Local Scalars ..
  100. INTEGER I, J
  101. * ..
  102. * .. Executable Statements ..
  103. *
  104. * Quick test for the common case where one corner is non-zero.
  105. IF( M.EQ.0 ) THEN
  106. ILADLR = M
  107. ELSE IF( A(M, 1).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
  108. ILADLR = M
  109. ELSE
  110. * Scan up each column tracking the last zero row seen.
  111. ILADLR = 0
  112. DO J = 1, N
  113. I=M
  114. DO WHILE((A(MAX(I,1),J).EQ.ZERO).AND.(I.GE.1))
  115. I=I-1
  116. ENDDO
  117. ILADLR = MAX( ILADLR, I )
  118. END DO
  119. END IF
  120. RETURN
  121. END