ilaslc.f 2.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118
  1. *> \brief \b ILASLC
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download ILASLC + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilaslc.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilaslc.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilaslc.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * INTEGER FUNCTION ILASLC( M, N, A, LDA )
  22. *
  23. * .. Scalar Arguments ..
  24. * INTEGER M, N, LDA
  25. * ..
  26. * .. Array Arguments ..
  27. * REAL A( LDA, * )
  28. * ..
  29. *
  30. *
  31. *> \par Purpose:
  32. * =============
  33. *>
  34. *> \verbatim
  35. *>
  36. *> ILASLC scans A for its last non-zero column.
  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 REAL 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 November 2011
  75. *
  76. *> \ingroup realOTHERauxiliary
  77. *
  78. * =====================================================================
  79. INTEGER FUNCTION ILASLC( M, N, A, LDA )
  80. *
  81. * -- LAPACK auxiliary routine (version 3.4.0) --
  82. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  83. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  84. * November 2011
  85. *
  86. * .. Scalar Arguments ..
  87. INTEGER M, N, LDA
  88. * ..
  89. * .. Array Arguments ..
  90. REAL A( LDA, * )
  91. * ..
  92. *
  93. * =====================================================================
  94. *
  95. * .. Parameters ..
  96. REAL ZERO
  97. PARAMETER ( ZERO = 0.0D+0 )
  98. * ..
  99. * .. Local Scalars ..
  100. INTEGER I
  101. * ..
  102. * .. Executable Statements ..
  103. *
  104. * Quick test for the common case where one corner is non-zero.
  105. IF( N.EQ.0 ) THEN
  106. ILASLC = N
  107. ELSE IF( A(1, N).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
  108. ILASLC = N
  109. ELSE
  110. * Now scan each column from the end, returning with the first non-zero.
  111. DO ILASLC = N, 1, -1
  112. DO I = 1, M
  113. IF( A(I, ILASLC).NE.ZERO ) RETURN
  114. END DO
  115. END DO
  116. END IF
  117. RETURN
  118. END