Actual source code: ilut.c
1: /*$Id: ilut.c,v 1.7 2001/08/06 21:15:14 bsmith Exp $*/
2: /* ilut.f -- translated by f2c (version of 25 March 1992 12:58:56).
4: The Fortran version of this code was developed by Yousef Saad.
5: This code is copyrighted by Yousef Saad with the
7: GNU GENERAL PUBLIC LICENSE
8: Version 2, June 1991
10: Copyright (C) 1989, 1991 Free Software Foundation, Inc.
11: 675 Mass Ave, Cambridge, MA 02139, USA
12: Everyone is permitted to copy and distribute verbatim copies
13: of this license document, but changing it is not allowed.
15: Preamble
17: The licenses for most software are designed to take away your
18: freedom to share and change it. By contrast, the GNU General Public
19: License is intended to guarantee your freedom to share and change free
20: software--to make sure the software is free for all its users. This
21: General Public License applies to most of the Free Software
22: Foundation's software and to any other program whose authors commit to
23: using it. (Some other Free Software Foundation software is covered by
24: the GNU Library General Public License instead.) You can apply it to
25: your programs, too.
27: When we speak of free software, we are referring to freedom, not
28: price. Our General Public Licenses are designed to make sure that you
29: have the freedom to distribute copies of free software (and charge for
30: this service if you wish), that you receive source code or can get it
31: if you want it, that you can change the software or use pieces of it
32: in new free programs; and that you know you can do these things.
34: To protect your rights, we need to make restrictions that forbid
35: anyone to deny you these rights or to ask you to surrender the rights.
36: These restrictions translate to certain responsibilities for you if you
37: distribute copies of the software, or if you modify it.
39: For example, if you distribute copies of such a program, whether
40: gratis or for a fee, you must give the recipients all the rights that
41: you have. You must make sure that they, too, receive or can get the
42: source code. And you must show them these terms so they know their
43: rights.
45: We protect your rights with two steps: (1) copyright the software, and
46: (2) offer you this license which gives you legal permission to copy,
47: distribute and/or modify the software.
49: Also, for each author's protection and ours, we want to make certain
50: that everyone understands that there is no warranty for this free
51: software. If the software is modified by someone else and passed on, we
52: want its recipients to know that what they have is not the original, so
53: that any problems introduced by others will not reflect on the original
54: authors' reputations.
56: Finally, any free program is threatened constantly by software
57: patents. We wish to avoid the danger that redistributors of a free
58: program will individually obtain patent licenses, in effect making the
59: program proprietary. To prevent this, we have made it clear that any
60: patent must be licensed for everyone's free use or not licensed at all.
62: The precise terms and conditions for copying, distribution and
63: modification follow.
64:
65: GNU GENERAL PUBLIC LICENSE
66: TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
68: 0. This License applies to any program or other work which contains
69: a notice placed by the copyright holder saying it may be distributed
70: under the terms of this General Public License. The "Program", below,
71: refers to any such program or work, and a "work based on the Program"
72: means either the Program or any derivative work under copyright law:
73: that is to say, a work containing the Program or a portion of it,
74: either verbatim or with modifications and/or translated into another
75: language. (Hereinafter, translation is included without limitation in
76: the term "modification".) Each licensee is addressed as "you".
78: Activities other than copying, distribution and modification are not
79: covered by this License; they are outside its scope. The act of
80: running the Program is not restricted, and the output from the Program
81: is covered only if its contents constitute a work based on the
82: Program (independent of having been made by running the Program).
83: Whether that is true depends on what the Program does.
85: 1. You may copy and distribute verbatim copies of the Program's
86: source code as you receive it, in any medium, provided that you
87: conspicuously and appropriately publish on each copy an appropriate
88: copyright notice and disclaimer of warranty; keep intact all the
89: notices that refer to this License and to the absence of any warranty;
90: and give any other recipients of the Program a copy of this License
91: along with the Program.
93: You may charge a fee for the physical act of transferring a copy, and
94: you may at your option offer warranty protection in exchange for a fee.
96: 2. You may modify your copy or copies of the Program or any portion
97: of it, thus forming a work based on the Program, and copy and
98: distribute such modifications or work under the terms of Section 1
99: above, provided that you also meet all of these conditions:
101: a) You must cause the modified files to carry prominent notices
102: stating that you changed the files and the date of any change.
104: b) You must cause any work that you distribute or publish, that in
105: whole or in part contains or is derived from the Program or any
106: part thereof, to be licensed as a whole at no charge to all third
107: parties under the terms of this License.
109: c) If the modified program normally reads commands interactively
110: when run, you must cause it, when started running for such
111: interactive use in the most ordinary way, to print or display an
112: announcement including an appropriate copyright notice and a
113: notice that there is no warranty (or else, saying that you provide
114: a warranty) and that users may redistribute the program under
115: these conditions, and telling the user how to view a copy of this
116: License. (Exception: if the Program itself is interactive but
117: does not normally print such an announcement, your work based on
118: the Program is not required to print an announcement.)
119:
120: These requirements apply to the modified work as a whole. If
121: identifiable sections of that work are not derived from the Program,
122: and can be reasonably considered independent and separate works in
123: themselves, then this License, and its terms, do not apply to those
124: sections when you distribute them as separate works. But when you
125: distribute the same sections as part of a whole which is a work based
126: on the Program, the distribution of the whole must be on the terms of
127: this License, whose permissions for other licensees extend to the
128: entire whole, and thus to each and every part regardless of who wrote it.
130: Thus, it is not the intent of this section to claim rights or contest
131: your rights to work written entirely by you; rather, the intent is to
132: exercise the right to control the distribution of derivative or
133: collective works based on the Program.
135: In addition, mere aggregation of another work not based on the Program
136: with the Program (or with a work based on the Program) on a volume of
137: a storage or distribution medium does not bring the other work under
138: the scope of this License.
140: 3. You may copy and distribute the Program (or a work based on it,
141: under Section 2) in object code or executable form under the terms of
142: Sections 1 and 2 above provided that you also do one of the following:
144: a) Accompany it with the complete corresponding machine-readable
145: source code, which must be distributed under the terms of Sections
146: 1 and 2 above on a medium customarily used for software interchange; or,
148: b) Accompany it with a written offer, valid for at least three
149: years, to give any third party, for a charge no more than your
150: cost of physically performing source distribution, a complete
151: machine-readable copy of the corresponding source code, to be
152: distributed under the terms of Sections 1 and 2 above on a medium
153: customarily used for software interchange; or,
155: c) Accompany it with the information you received as to the offer
156: to distribute corresponding source code. (This alternative is
157: allowed only for noncommercial distribution and only if you
158: received the program in object code or executable form with such
159: an offer, in accord with Subsection b above.)
161: The source code for a work means the preferred form of the work for
162: making modifications to it. For an executable work, complete source
163: code means all the source code for all modules it contains, plus any
164: associated interface definition files, plus the scripts used to
165: control compilation and installation of the executable. However, as a
166: special exception, the source code distributed need not include
167: anything that is normally distributed (in either source or binary
168: form) with the major components (compiler, kernel, and so on) of the
169: operating system on which the executable runs, unless that component
170: itself accompanies the executable.
172: If distribution of executable or object code is made by offering
173: access to copy from a designated place, then offering equivalent
174: access to copy the source code from the same place counts as
175: distribution of the source code, even though third parties are not
176: compelled to copy the source along with the object code.
177:
178: 4. You may not copy, modify, sublicense, or distribute the Program
179: except as expressly provided under this License. Any attempt
180: otherwise to copy, modify, sublicense or distribute the Program is
181: void, and will automatically terminate your rights under this License.
182: However, parties who have received copies, or rights, from you under
183: this License will not have their licenses terminated so long as such
184: parties remain in full compliance.
186: 5. You are not required to accept this License, since you have not
187: signed it. However, nothing else grants you permission to modify or
188: distribute the Program or its derivative works. These actions are
189: prohibited by law if you do not accept this License. Therefore, by
190: modifying or distributing the Program (or any work based on the
191: Program), you indicate your acceptance of this License to do so, and
192: all its terms and conditions for copying, distributing or modifying
193: the Program or works based on it.
195: 6. Each time you redistribute the Program (or any work based on the
196: Program), the recipient automatically receives a license from the
197: original licensor to copy, distribute or modify the Program subject to
198: these terms and conditions. You may not impose any further
199: restrictions on the recipients' exercise of the rights granted herein.
200: You are not responsible for enforcing compliance by third parties to
201: this License.
203: 7. If, as a consequence of a court judgment or allegation of patent
204: infringement or for any other reason (not limited to patent issues),
205: conditions are imposed on you (whether by court order, agreement or
206: otherwise) that contradict the conditions of this License, they do not
207: excuse you from the conditions of this License. If you cannot
208: distribute so as to satisfy simultaneously your obligations under this
209: License and any other pertinent obligations, then as a consequence you
210: may not distribute the Program at all. For example, if a patent
211: license would not permit royalty-free redistribution of the Program by
212: all those who receive copies directly or indirectly through you, then
213: the only way you could satisfy both it and this License would be to
214: refrain entirely from distribution of the Program.
216: If any portion of this section is held invalid or unenforceable under
217: any particular circumstance, the balance of the section is intended to
218: apply and the section as a whole is intended to apply in other
219: circumstances.
221: It is not the purpose of this section to induce you to infringe any
222: patents or other property right claims or to contest validity of any
223: such claims; this section has the sole purpose of protecting the
224: integrity of the free software distribution system, which is
225: implemented by public license practices. Many people have made
226: generous contributions to the wide range of software distributed
227: through that system in reliance on consistent application of that
228: system; it is up to the author/donor to decide if he or she is willing
229: to distribute software through any other system and a licensee cannot
230: impose that choice.
232: This section is intended to make thoroughly clear what is believed to
233: be a consequence of the rest of this License.
234:
235: 8. If the distribution and/or use of the Program is restricted in
236: certain countries either by patents or by copyrighted interfaces, the
237: original copyright holder who places the Program under this License
238: may add an explicit geographical distribution limitation excluding
239: those countries, so that distribution is permitted only in or among
240: countries not thus excluded. In such case, this License incorporates
241: the limitation as if written in the body of this License.
243: 9. The Free Software Foundation may publish revised and/or new versions
244: of the General Public License from time to time. Such new versions will
245: be similar in spirit to the present version, but may differ in detail to
246: address new problems or concerns.
248: Each version is given a distinguishing version number. If the Program
249: specifies a version number of this License which applies to it and "any
250: later version", you have the option of following the terms and conditions
251: either of that version or of any later version published by the Free
252: Software Foundation. If the Program does not specify a version number of
253: this License, you may choose any version ever published by the Free Software
254: Foundation.
256: 10. If you wish to incorporate parts of the Program into other free
257: programs whose distribution conditions are different, write to the author
258: to ask for permission. For software which is copyrighted by the Free
259: Software Foundation, write to the Free Software Foundation; we sometimes
260: make exceptions for this. Our decision will be guided by the two goals
261: of preserving the free status of all derivatives of our free software and
262: of promoting the sharing and reuse of software generally.
264: NO WARRANTY
266: 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
267: FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
268: OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
269: PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
270: OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
271: MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
272: TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
273: PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
274: REPAIR OR CORRECTION.
276: 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
277: WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
278: REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
279: INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
280: OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
281: TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
282: YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
283: PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
284: POSSIBILITY OF SUCH DAMAGES.
286: END OF TERMS AND CONDITIONS
287:
288: Appendix: How to Apply These Terms to Your New Programs
290: If you develop a new program, and you want it to be of the greatest
291: possible use to the public, the best way to achieve this is to make it
292: free software which everyone can redistribute and change under these terms.
294: To do so, attach the following notices to the program. It is safest
295: to attach them to the start of each source file to most effectively
296: convey the exclusion of warranty; and each file should have at least
297: the "copyright" line and a pointer to where the full notice is found.
299: <one line to give the program's name and a brief idea of what it does.>
300: Copyright (C) 19yy <name of author>
302: This program is free software; you can redistribute it and/or modify
303: it under the terms of the GNU General Public License as published by
304: the Free Software Foundation; either version 2 of the License, or
305: (at your option) any later version.
307: This program is distributed in the hope that it will be useful,
308: but WITHOUT ANY WARRANTY; without even the implied warranty of
309: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
310: GNU General Public License for more details.
312: You should have received a copy of the GNU General Public License
313: along with this program; if not, write to the Free Software
314: Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
316: Also add information on how to contact you by electronic and paper mail.
318: If the program is interactive, make it output a short notice like this
319: when it starts in an interactive mode:
321: Gnomovision version 69, Copyright (C) 19yy name of author
322: Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
323: This is free software, and you are welcome to redistribute it
324: under certain conditions; type `show c' for details.
326: The hypothetical commands `show w' and `show c' should show the appropriate
327: parts of the General Public License. Of course, the commands you use may
328: be called something other than `show w' and `show c'; they could even be
329: mouse-clicks or menu items--whatever suits your program.
331: You should also get your employer (if you work as a programmer) or your
332: school, if any, to sign a "copyright disclaimer" for the program, if
333: necessary. Here is a sample; alter the names:
335: Yoyodyne, Inc., hereby disclaims all copyright interest in the program
336: `Gnomovision' (which makes passes at compilers) written by James Hacker.
338: <signature of Ty Coon>, 1 April 1989
339: Ty Coon, President of Vice
341: This General Public License does not permit incorporating your program into
342: proprietary programs. If your program is a subroutine library, you may
343: consider it more useful to permit linking proprietary applications with the
344: library. If this is what you want to do, use the GNU Library General
345: Public License instead of this License.
347: */
348: #include petsc.h
350: static int SPARSEKIT2qsplit(PetscScalar *a,int *ind,int *n,int *ncut)
351: {
352: /* System generated locals */
353: int i__1;
354: PetscScalar d__1;
356: /* Local variables */
357: int last,itmp,j,first;
358: PetscReal abskey;
359: int mid;
360: PetscScalar tmp;
362: /* -----------------------------------------------------------------------
363: */
364: /* does a quick-sort split of a real array. */
365: /* on input a(1:n). is a real array */
366: /* on output a(1:n) is permuted such that its elements satisfy: */
368: /* abs(a(i)) .ge. abs(a(ncut)) for i .lt. ncut and */
369: /* abs(a(i)) .le. abs(a(ncut)) for i .gt. ncut */
371: /* ind(1:n) is an integer array which permuted in the same way as a(*).
372: */
373: /* -----------------------------------------------------------------------
374: */
375: /* ----- */
376: /* Parameter adjustments */
377: --ind;
378: --a;
380: /* Function Body */
381: first = 1;
382: last = *n;
383: if (*ncut < first || *ncut > last) {
384: return 0;
385: }
387: /* outer loop -- while mid .ne. ncut do */
389: L1:
390: mid = first;
391: abskey = (d__1 = a[mid],PetscAbsScalar(d__1));
392: i__1 = last;
393: for (j = first + 1; j <= i__1; ++j) {
394: if ((d__1 = a[j],PetscAbsScalar(d__1)) > abskey) {
395: ++mid;
396: /* interchange */
397: tmp = a[mid];
398: itmp = ind[mid];
399: a[mid] = a[j];
400: ind[mid] = ind[j];
401: a[j] = tmp;
402: ind[j] = itmp;
403: }
404: /* L2: */
405: }
407: /* interchange */
409: tmp = a[mid];
410: a[mid] = a[first];
411: a[first] = tmp;
413: itmp = ind[mid];
414: ind[mid] = ind[first];
415: ind[first] = itmp;
417: /* test for while loop */
419: if (mid == *ncut) {
420: return 0;
421: }
422: if (mid > *ncut) {
423: last = mid - 1;
424: } else {
425: first = mid + 1;
426: }
427: goto L1;
428: /* ----------------end-of-qsplit------------------------------------------
429: */
430: /* -----------------------------------------------------------------------
431: */
432: } /* qsplit_ */
435: /* ---------------------------------------------------------------------- */
436: int SPARSEKIT2ilutp(int *n,PetscScalar *a,int *ja,int * ia,int *lfil,PetscReal droptol,PetscReal *permtol,int *mbloc,PetscScalar *alu,
437: int *jlu,int *ju,int *iwk,PetscScalar *w,int *jw, int *iperm,int *ierr)
438: {
439: /* System generated locals */
440: int i__1,i__2;
441: PetscScalar d__1;
443: /* Local variables */
444: PetscScalar fact;
445: int lenl,imax,lenu,icut,jpos;
446: PetscReal xmax;
447: int jrow;
448: PetscReal xmax0;
449: int i,j,k;
450: PetscScalar s,t;
451: int j_1,j2;
452: PetscReal tnorm,t1;
453: int ii,jj;
454: int ju0,len;
455: PetscScalar tmp;
457: /* -----------------------------------------------------------------------
458: */
459: /* implicit none */
460: /* ----------------------------------------------------------------------*
461: */
462: /* *** ILUTP preconditioner -- ILUT with pivoting *** *
463: */
464: /* incomplete LU factorization with dual truncation mechanism *
465: */
466: /* ----------------------------------------------------------------------*
467: */
468: /* author Yousef Saad *Sep 8, 1993 -- Latest revision, August 1996. *
469: */
470: /* ----------------------------------------------------------------------*
471: */
472: /* on entry: */
473: /* ========== */
474: /* n = integer. The dimension of the matrix A. */
476: /* a,ja,ia = matrix stored in Compressed Sparse Row format. */
477: /* ON RETURN THE COLUMNS OF A ARE PERMUTED. SEE BELOW FOR */
478: /* DETAILS. */
480: /* lfil = integer. The fill-in parameter. Each row of L and each row */
482: /* of U will have a maximum of lfil elements (excluding the */
483: /* diagonal element). lfil must be .ge. 0. */
484: /* ** WARNING: THE MEANING OF LFIL HAS CHANGED WITH RESPECT TO
485: */
486: /* EARLIER VERSIONS. */
488: /* droptol = real*8. Sets the threshold for dropping small terms in the */
490: /* factorization. See below for details on dropping strategy. */
493: /* lfil = integer. The fill-in parameter. Each row of L and */
494: /* each row of U will have a maximum of lfil elements. */
495: /* WARNING: THE MEANING OF LFIL HAS CHANGED WITH RESPECT TO */
496: /* EARLIER VERSIONS. */
497: /* lfil must be .ge. 0. */
499: /* permtol = tolerance ratio used to determne whether or not to permute
500: */
501: /* two columns. At step i columns i and j are permuted when */
503: /* abs(a(i,j))*permtol .gt. abs(a(i,i)) */
505: /* [0 --> never permute; good values 0.1 to 0.01] */
507: /* mbloc = if desired, permuting can be done only within the diagonal */
509: /* blocks of size mbloc. Useful for PDE problems with several */
511: /* degrees of freedom.. If feature not wanted take mbloc=n. */
514: /* iwk = integer. The lengths of arrays alu and jlu. If the arrays */
515: /* are not big enough to store the ILU factorizations, ilut */
516: /* will stop with an error message. */
518: /* On return: */
519: /* =========== */
521: /* alu,jlu = matrix stored in Modified Sparse Row (MSR) format containing
522: */
523: /* the L and U factors together. The diagonal (stored in */
524: /* alu(1:n)) is inverted. Each i-th row of the alu,jlu matrix
525: */
526: /* contains the i-th row of L (excluding the diagonal entry=1)
527: */
528: /* followed by the i-th row of U. */
530: /* ju = integer array of length n containing the pointers to */
531: /* the beginning of each row of U in the matrix alu,jlu. */
533: /* iperm = contains the permutation arrays. */
534: /* iperm(1:n) = old numbers of unknowns */
535: /* iperm(n+1:2*n) = reverse permutation = new unknowns. */
537: /* integer. Error message with the following meaning. */
538: /* 0 --> successful return. */
539: /* ierr .gt. 0 --> zero pivot encountered at step number ierr.
540: */
541: /* -1 --> Error. input matrix may be wrong. */
542: /* (The elimination process has generated a */
543: /* row in L or U whose length is .gt. n.) */
544: /* -2 --> The matrix L overflows the array al. */
545: /* -3 --> The matrix U overflows the array alu. */
546: /* -4 --> Illegal value for lfil. */
547: /* -5 --> zero row encountered. */
549: /* work arrays: */
550: /* ============= */
551: /* jw = integer work array of length 2*n. */
552: /* w = real work array of length n */
554: /* IMPORTANR NOTE: */
555: /* -------------- */
556: /* TO AVOID PERMUTING THE SOLUTION VECTORS ARRAYS FOR EACH LU-SOLVE, */
557: /* THE MATRIX A IS PERMUTED ON RETURN. [all column indices are */
558: /* changed]. SIMILARLY FOR THE U MATRIX. */
559: /* To permute the matrix back to its original state use the loop: */
561: /* do k=ia(1), ia(n+1)-1 */
562: /* ja(k) = iperm(ja(k)) */
563: /* enddo */
565: /* -----------------------------------------------------------------------
566: */
567: /* local variables */
570: /* Parameter adjustments */
571: --iperm;
572: --jw;
573: --w;
574: --ju;
575: --jlu;
576: --alu;
577: --ia;
578: --ja;
579: --a;
581: /* Function Body */
582: if (*lfil < 0) {
583: goto L998;
584: }
585: /* -----------------------------------------------------------------------
586: */
587: /* initialize ju0 (points to next element to be added to alu,jlu) */
588: /* and pointer array. */
589: /* -----------------------------------------------------------------------
590: */
591: ju0 = *n + 2;
592: jlu[1] = ju0;
594: /* integer PetscReal pointer array. */
596: i__1 = *n;
597: for (j = 1; j <= i__1; ++j) {
598: jw[*n + j] = 0;
599: iperm[j] = j;
600: iperm[*n + j] = j;
601: /* L1: */
602: }
603: /* -----------------------------------------------------------------------
604: */
605: /* beginning of main loop. */
606: /* -----------------------------------------------------------------------
607: */
608: i__1 = *n;
609: for (ii = 1; ii <= i__1; ++ii) {
610: j_1 = ia[ii];
611: j2 = ia[ii + 1] - 1;
612: tnorm = 0.;
613: i__2 = j2;
614: for (k = j_1; k <= i__2; ++k) {
615: tnorm += (d__1 = a[k], PetscAbsScalar(d__1));
616: /* L501: */
617: }
618: if (tnorm == 0.) {
619: goto L999;
620: }
621: tnorm /= j2 - j_1 + 1;
623: /* unpack L-part and U-part of row of A in arrays w -- */
625: lenu = 1;
626: lenl = 0;
627: jw[ii] = ii;
628: w[ii] = (float)0.;
629: jw[*n + ii] = ii;
631: i__2 = j2;
632: for (j = j_1; j <= i__2; ++j) {
633: k = iperm[*n + ja[j]];
634: t = a[j];
635: if (k < ii) {
636: ++lenl;
637: jw[lenl] = k;
638: w[lenl] = t;
639: jw[*n + k] = lenl;
640: } else if (k == ii) {
641: w[ii] = t;
642: } else {
643: ++lenu;
644: jpos = ii + lenu - 1;
645: jw[jpos] = k;
646: w[jpos] = t;
647: jw[*n + k] = jpos;
648: }
649: /* L170: */
650: }
651: jj = 0;
652: len = 0;
654: /* eliminate previous rows */
656: L150:
657: ++jj;
658: if (jj > lenl) {
659: goto L160;
660: }
661: /* ------------------------------------------------------------------
662: ----- */
663: /* in order to do the elimination in the correct order we must sel
664: ect */
665: /* the smallest column index among jw(k), k=jj+1, ..., lenl. */
666: /* ------------------------------------------------------------------
667: ----- */
668: jrow = jw[jj];
669: k = jj;
671: /* determine smallest column index */
673: i__2 = lenl;
674: for (j = jj + 1; j <= i__2; ++j) {
675: if (jw[j] < jrow) {
676: jrow = jw[j];
677: k = j;
678: }
679: /* L151: */
680: }
682: if (k != jj) {
683: /* exchange in jw */
684: j = jw[jj];
685: jw[jj] = jw[k];
686: jw[k] = j;
687: /* exchange in jr */
688: jw[*n + jrow] = jj;
689: jw[*n + j] = k;
690: /* exchange in w */
691: s = w[jj];
692: w[jj] = w[k];
693: w[k] = s;
694: }
696: /* zero out element in row by resetting jw(n+jrow) to zero. */
698: jw[*n + jrow] = 0;
700: /* get the multiplier for row to be eliminated: jrow */
702: fact = w[jj] * alu[jrow];
704: /* drop term if small */
706: if (PetscAbsScalar(fact) <= droptol) {
707: goto L150;
708: }
710: /* combine current row and row jrow */
712: i__2 = jlu[jrow + 1] - 1;
713: for (k = ju[jrow]; k <= i__2; ++k) {
714: s = fact * alu[k];
715: /* new column number */
716: j = iperm[*n + jlu[k]];
717: jpos = jw[*n + j];
718: if (j >= ii) {
720: /* dealing with upper part. */
722: if (jpos == 0) {
724: /* this is a fill-in element */
726: ++lenu;
727: i = ii + lenu - 1;
728: if (lenu > *n) {
729: goto L995;
730: }
731: jw[i] = j;
732: jw[*n + j] = i;
733: w[i] = -s;
734: } else {
735: /* no fill-in element -- */
736: w[jpos] -= s;
737: }
738: } else {
740: /* dealing with lower part. */
742: if (jpos == 0) {
744: /* this is a fill-in element */
746: ++lenl;
747: if (lenl > *n) {
748: goto L995;
749: }
750: jw[lenl] = j;
751: jw[*n + j] = lenl;
752: w[lenl] = -s;
753: } else {
755: /* this is not a fill-in element */
757: w[jpos] -= s;
758: }
759: }
760: /* L203: */
761: }
763: /* store this pivot element -- (from left to right -- no danger of
764: */
765: /* overlap with the working elements in L (pivots). */
767: ++len;
768: w[len] = fact;
769: jw[len] = jrow;
770: goto L150;
771: L160:
773: /* reset double-pointer to zero (U-part) */
775: i__2 = lenu;
776: for (k = 1; k <= i__2; ++k) {
777: jw[*n + jw[ii + k - 1]] = 0;
778: /* L308: */
779: }
781: /* update L-matrix */
783: lenl = len;
784: len = PetscMin(lenl,*lfil);
786: /* sort by quick-split */
788: SPARSEKIT2qsplit(&w[1], &jw[1], &lenl, &len);
790: /* store L-part -- in original coordinates .. */
792: i__2 = len;
793: for (k = 1; k <= i__2; ++k) {
794: if (ju0 > *iwk) {
795: goto L996;
796: }
797: alu[ju0] = w[k];
798: jlu[ju0] = iperm[jw[k]];
799: ++ju0;
800: /* L204: */
801: }
803: /* save pointer to beginning of row ii of U */
805: ju[ii] = ju0;
807: /* update U-matrix -- first apply dropping strategy */
809: len = 0;
810: i__2 = lenu - 1;
811: for (k = 1; k <= i__2; ++k) {
812: if ((d__1 = w[ii + k], PetscAbsScalar(d__1)) > droptol * tnorm) {
813: ++len;
814: w[ii + len] = w[ii + k];
815: jw[ii + len] = jw[ii + k];
816: }
817: }
818: lenu = len + 1;
819: len = PetscMin(lenu,*lfil);
820: i__2 = lenu - 1;
821: SPARSEKIT2qsplit(&w[ii + 1], &jw[ii + 1], &i__2, &len);
823: /* determine next pivot -- */
825: imax = ii;
826: xmax = (d__1 = w[imax], PetscAbsScalar(d__1));
827: xmax0 = xmax;
828: icut = ii - 1 + *mbloc - (ii - 1) % *mbloc;
829: i__2 = ii + len - 1;
830: for (k = ii + 1; k <= i__2; ++k) {
831: t1 = (d__1 = w[k], PetscAbsScalar(d__1));
832: if (t1 > xmax && t1 * *permtol > xmax0 && jw[k] <= icut) {
833: imax = k;
834: xmax = t1;
835: }
836: }
838: /* exchange w's */
840: tmp = w[ii];
841: w[ii] = w[imax];
842: w[imax] = tmp;
844: /* update iperm and reverse iperm */
846: j = jw[imax];
847: i = iperm[ii];
848: iperm[ii] = iperm[j];
849: iperm[j] = i;
851: /* reverse iperm */
853: iperm[*n + iperm[ii]] = ii;
854: iperm[*n + iperm[j]] = j;
855: /* ------------------------------------------------------------------
856: ----- */
858: if (len + ju0 > *iwk) {
859: goto L997;
860: }
862: /* copy U-part in original coordinates */
864: i__2 = ii + len - 1;
865: for (k = ii + 1; k <= i__2; ++k) {
866: jlu[ju0] = iperm[jw[k]];
867: alu[ju0] = w[k];
868: ++ju0;
869: /* L302: */
870: }
872: /* store inverse of diagonal element of u */
874: if (w[ii] == 0.) {
875: w[ii] = (droptol + 1e-4) * tnorm;
876: }
877: alu[ii] = 1. / w[ii];
879: /* update pointer to beginning of next row of U. */
881: jlu[ii + 1] = ju0;
882: /* ------------------------------------------------------------------
883: ----- */
884: /* end main loop */
885: /* ------------------------------------------------------------------
886: ----- */
887: /* L500: */
888: }
890: /* permute all column indices of LU ... */
892: i__1 = jlu[*n + 1] - 1;
893: for (k = jlu[1]; k <= i__1; ++k) {
894: jlu[k] = iperm[*n + jlu[k]];
895: }
897: /* ...and of A */
899: i__1 = ia[*n + 1] - 1;
900: for (k = ia[1]; k <= i__1; ++k) {
901: ja[k] = iperm[*n + ja[k]];
902: }
904: *0;
905: return 0;
907: /* incomprehensible error. Matrix must be wrong. */
909: L995:
910: *-1;
911: return 0;
913: /* insufficient storage in L. */
915: L996:
916: *-2;
917: return 0;
919: /* insufficient storage in U. */
921: L997:
922: *-3;
923: return 0;
925: /* illegal lfil entered. */
927: L998:
928: *-4;
929: return 0;
931: /* zero row encountered */
933: L999:
934: *-5;
935: return 0;
936: /* ----------------end-of-ilutp-------------------------------------------
937: */
938: /* -----------------------------------------------------------------------
939: */
940: } /* ilutp_ */