isdir.f 9.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212
  1. *DECK ISDIR
  2. INTEGER FUNCTION ISDIR (N, B, X, NELT, IA, JA, A, ISYM, MSOLVE,
  3. + ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, R, Z, DZ, RWORK,
  4. + IWORK, BNRM, SOLNRM)
  5. C***BEGIN PROLOGUE ISDIR
  6. C***SUBSIDIARY
  7. C***PURPOSE Preconditioned Iterative Refinement Stop Test.
  8. C This routine calculates the stop test for the iterative
  9. C refinement iteration scheme. It returns a non-zero if the
  10. C error estimate (the type of which is determined by ITOL)
  11. C is less than the user specified tolerance TOL.
  12. C***LIBRARY SLATEC (SLAP)
  13. C***CATEGORY D2A4, D2B4
  14. C***TYPE DOUBLE PRECISION (ISSIR-S, ISDIR-D)
  15. C***KEYWORDS LINEAR SYSTEM, SLAP, SPARSE, STOP TEST
  16. C***AUTHOR Greenbaum, Anne, (Courant Institute)
  17. C Seager, Mark K., (LLNL)
  18. C Lawrence Livermore National Laboratory
  19. C PO BOX 808, L-60
  20. C Livermore, CA 94550 (510) 423-3141
  21. C seager@llnl.gov
  22. C***DESCRIPTION
  23. C
  24. C *Usage:
  25. C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX, ITER
  26. C INTEGER IERR, IUNIT, IWORK(USER DEFINED)
  27. C DOUBLE PRECISION B(N), X(N), A(N), TOL, ERR, R(N), Z(N), DZ(N)
  28. C DOUBLE PRECISION RWORK(USER DEFINED), BNRM, SOLNRM
  29. C EXTERNAL MSOLVE
  30. C
  31. C IF( ISDIR(N, B, X, NELT, IA, JA, A, ISYM, MSOLVE, ITOL, TOL,
  32. C $ ITMAX, ITER, ERR, IERR, IUNIT, R, Z, DZ, RWORK, IWORK,
  33. C $ BNRM, SOLNRM) .NE. 0 ) THEN ITERATION DONE
  34. C
  35. C *Arguments:
  36. C N :IN Integer.
  37. C Order of the Matrix.
  38. C B :IN Double Precision B(N).
  39. C Right-hand side vector.
  40. C X :IN Double Precision X(N).
  41. C The current approximate solution vector.
  42. C NELT :IN Integer.
  43. C Number of Non-Zeros stored in A.
  44. C IA :IN Integer IA(NELT).
  45. C JA :IN Integer JA(NELT).
  46. C A :IN Double Precision A(NELT).
  47. C These arrays contain the matrix data structure for A.
  48. C It could take any form. See "C *Description" in the
  49. C DIR routine.
  50. C ISYM :IN Integer.
  51. C Flag to indicate symmetric storage format.
  52. C If ISYM=0, all non-zero entries of the matrix are stored.
  53. C If ISYM=1, the matrix is symmetric, and only the upper
  54. C or lower triangle of the matrix is stored.
  55. C MSOLVE :EXT External.
  56. C Name of a routine which solves a linear system Mz = r for
  57. C z given r with the preconditioning matrix M (M is supplied via
  58. C RWORK and IWORK arrays. The name of the MSOLVE routine must
  59. C be declared external in the calling program. The calling
  60. C sequence to MSOLVE is:
  61. C CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK)
  62. C Where N is the number of unknowns, R is the right-hand side
  63. C vector and Z is the solution upon return. NELT, IA, JA, A and
  64. C ISYM are defined as above. RWORK is a double precision array
  65. C that can be used to pass necessary preconditioning information
  66. C and/or workspace to MSOLVE. IWORK is an integer work array
  67. C for the same purpose as RWORK.
  68. C ITOL :IN Integer.
  69. C Flag to indicate type of convergence criterion.
  70. C If ITOL=1, iteration stops when the 2-norm of the residual
  71. C divided by the 2-norm of the right-hand side is less than TOL.
  72. C If ITOL=2, iteration stops when the 2-norm of M-inv times the
  73. C residual divided by the 2-norm of M-inv times the right hand
  74. C side is less than TOL, where M-inv is the inverse of the
  75. C diagonal of A.
  76. C ITOL=11 is often useful for checking and comparing different
  77. C routines. For this case, the user must supply the "exact"
  78. C solution or a very accurate approximation (one with an error
  79. C much less than TOL) through a common block,
  80. C COMMON /DSLBLK/ SOLN( )
  81. C If ITOL=11, iteration stops when the 2-norm of the difference
  82. C between the iterative approximation and the user-supplied
  83. C solution divided by the 2-norm of the user-supplied solution
  84. C is less than TOL. Note that this requires the user to set up
  85. C the "COMMON /DSLBLK/ SOLN(LENGTH)" in the calling routine.
  86. C The routine with this declaration should be loaded before the
  87. C stop test so that the correct length is used by the loader.
  88. C This procedure is not standard Fortran and may not work
  89. C correctly on your system (although it has worked on every
  90. C system the authors have tried). If ITOL is not 11 then this
  91. C common block is indeed standard Fortran.
  92. C TOL :IN Double Precision.
  93. C Convergence criterion, as described above.
  94. C ITMAX :IN Integer.
  95. C Maximum number of iterations.
  96. C ITER :IN Integer.
  97. C Current iteration count. (Must be zero on first call.)
  98. C ERR :OUT Double Precision.
  99. C Error estimate of error in the X(N) approximate solution, as
  100. C defined by ITOL.
  101. C IERR :OUT Integer.
  102. C Error flag. IERR is set to 3 if ITOL is not one of the
  103. C acceptable values, see above.
  104. C IUNIT :IN Integer.
  105. C Unit number on which to write the error at each iteration,
  106. C if this is desired for monitoring convergence. If unit
  107. C number is 0, no writing will occur.
  108. C R :IN Double Precision R(N).
  109. C The residual R = B-AX.
  110. C Z :WORK Double Precision Z(N).
  111. C Workspace used to hold the pseudo-residual M z = r.
  112. C DZ :WORK Double Precision DZ(N).
  113. C Workspace used to hold temporary vector(s).
  114. C RWORK :WORK Double Precision RWORK(USER DEFINED).
  115. C Double Precision array that can be used by MSOLVE.
  116. C IWORK :WORK Integer IWORK(USER DEFINED).
  117. C Integer array that can be used by MSOLVE.
  118. C BNRM :INOUT Double Precision.
  119. C Norm of the right hand side. Type of norm depends on ITOL.
  120. C Calculated only on the first call.
  121. C SOLNRM :INOUT Double Precision.
  122. C 2-Norm of the true solution, SOLN. Only computed and used
  123. C if ITOL = 11.
  124. C
  125. C *Function Return Values:
  126. C 0 : Error estimate (determined by ITOL) is *NOT* less than the
  127. C specified tolerance, TOL. The iteration must continue.
  128. C 1 : Error estimate (determined by ITOL) is less than the
  129. C specified tolerance, TOL. The iteration can be considered
  130. C complete.
  131. C
  132. C *Cautions:
  133. C This routine will attempt to write to the Fortran logical output
  134. C unit IUNIT, if IUNIT .ne. 0. Thus, the user must make sure that
  135. C this logical unit is attached to a file or terminal before calling
  136. C this routine with a non-zero value for IUNIT. This routine does
  137. C not check for the validity of a non-zero IUNIT unit number.
  138. C
  139. C***SEE ALSO DIR, DSJAC, DSGS
  140. C***ROUTINES CALLED D1MACH, DNRM2
  141. C***COMMON BLOCKS DSLBLK
  142. C***REVISION HISTORY (YYMMDD)
  143. C 871119 DATE WRITTEN
  144. C 880320 Previous REVISION DATE
  145. C 890915 Made changes requested at July 1989 CML Meeting. (MKS)
  146. C 890922 Numerous changes to prologue to make closer to SLATEC
  147. C standard. (FNF)
  148. C 890929 Numerous changes to reduce SP/DP differences. (FNF)
  149. C 891003 Removed C***REFER TO line, per MKS.
  150. C 910411 Prologue converted to Version 4.0 format. (BAB)
  151. C 910502 Removed MSOLVE from ROUTINES CALLED list. (FNF)
  152. C 910506 Made subsidiary to DIR. (FNF)
  153. C 920407 COMMON BLOCK renamed DSLBLK. (WRB)
  154. C 920511 Added complete declaration section. (WRB)
  155. C 921026 Changed 1.0E10 to D1MACH(2) and corrected E to D in
  156. C output format. (FNF)
  157. C***END PROLOGUE ISDIR
  158. C .. Scalar Arguments ..
  159. DOUBLE PRECISION BNRM, ERR, SOLNRM, TOL
  160. INTEGER IERR, ISYM, ITER, ITMAX, ITOL, IUNIT, N, NELT
  161. C .. Array Arguments ..
  162. DOUBLE PRECISION A(NELT), B(N), DZ(N), R(N), RWORK(*), X(N), Z(N)
  163. INTEGER IA(NELT), IWORK(*), JA(NELT)
  164. C .. Subroutine Arguments ..
  165. EXTERNAL MSOLVE
  166. C .. Arrays in Common ..
  167. DOUBLE PRECISION SOLN(1)
  168. C .. Local Scalars ..
  169. INTEGER I
  170. C .. External Functions ..
  171. DOUBLE PRECISION D1MACH, DNRM2
  172. EXTERNAL D1MACH, DNRM2
  173. C .. Common blocks ..
  174. COMMON /DSLBLK/ SOLN
  175. C***FIRST EXECUTABLE STATEMENT ISDIR
  176. ISDIR = 0
  177. IF( ITOL.EQ.1 ) THEN
  178. C err = ||Residual||/||RightHandSide|| (2-Norms).
  179. IF(ITER .EQ. 0) BNRM = DNRM2(N, B, 1)
  180. ERR = DNRM2(N, R, 1)/BNRM
  181. ELSE IF( ITOL.EQ.2 ) THEN
  182. C -1 -1
  183. C err = ||M Residual||/||M RightHandSide|| (2-Norms).
  184. IF(ITER .EQ. 0) THEN
  185. CALL MSOLVE(N, B, DZ, NELT, IA, JA, A, ISYM, RWORK, IWORK)
  186. BNRM = DNRM2(N, DZ, 1)
  187. ENDIF
  188. ERR = DNRM2(N, Z, 1)/BNRM
  189. ELSE IF( ITOL.EQ.11 ) THEN
  190. C err = ||x-TrueSolution||/||TrueSolution|| (2-Norms).
  191. IF( ITER.EQ.0 ) SOLNRM = DNRM2(N, SOLN, 1)
  192. DO 10 I = 1, N
  193. DZ(I) = X(I) - SOLN(I)
  194. 10 CONTINUE
  195. ERR = DNRM2(N, DZ, 1)/SOLNRM
  196. ELSE
  197. C
  198. C If we get here ITOL is not one of the acceptable values.
  199. ERR = D1MACH(2)
  200. IERR = 3
  201. ENDIF
  202. C
  203. IF( IUNIT.NE.0 ) THEN
  204. WRITE(IUNIT,1000) ITER,ERR
  205. ENDIF
  206. C
  207. IF( ERR.LE.TOL ) ISDIR = 1
  208. C
  209. RETURN
  210. 1000 FORMAT(5X,'ITER = ',I4,' Error Estimate = ',D16.7)
  211. C------------- LAST LINE OF ISDIR FOLLOWS -----------------------------
  212. END