Actual source code: ilut.c

  1: /* ilut.f -- translated by f2c (version of 25 March 1992  12:58:56).

  3:      The Fortran version of this code was developed by Yousef Saad.
  4:   This code is copyrighted by Yousef Saad with the 

  6:                     GNU GENERAL PUBLIC LICENSE
  7:                        Version 2, June 1991

  9:  Copyright (C) 1989, 1991 Free Software Foundation, Inc.
 10:                           675 Mass Ave, Cambridge, MA 02139, USA
 11:  Everyone is permitted to copy and distribute verbatim copies
 12:  of this license document, but changing it is not allowed.

 14:                             Preamble

 16:   The licenses for most software are designed to take away your
 17: freedom to share and change it.  By contrast, the GNU General Public
 18: License is intended to guarantee your freedom to share and change free
 19: software--to make sure the software is free for all its users.  This
 20: General Public License applies to most of the Free Software
 21: Foundation's software and to any other program whose authors commit to
 22: using it.  (Some other Free Software Foundation software is covered by
 23: the GNU Library General Public License instead.)  You can apply it to
 24: your programs, too.

 26:   When we speak of free software, we are referring to freedom, not
 27: price.  Our General Public Licenses are designed to make sure that you
 28: have the freedom to distribute copies of free software (and charge for
 29: this service if you wish), that you receive source code or can get it
 30: if you want it, that you can change the software or use pieces of it
 31: in new free programs; and that you know you can do these things.

 33:   To protect your rights, we need to make restrictions that forbid
 34: anyone to deny you these rights or to ask you to surrender the rights.
 35: These restrictions translate to certain responsibilities for you if you
 36: distribute copies of the software, or if you modify it.

 38:   For example, if you distribute copies of such a program, whether
 39: gratis or for a fee, you must give the recipients all the rights that
 40: you have.  You must make sure that they, too, receive or can get the
 41: source code.  And you must show them these terms so they know their
 42: rights.

 44:   We protect your rights with two steps: (1) copyright the software, and
 45: (2) offer you this license which gives you legal permission to copy,
 46: distribute and/or modify the software.

 48:   Also, for each author's protection and ours, we want to make certain
 49: that everyone understands that there is no warranty for this free
 50: software.  If the software is modified by someone else and passed on, we
 51: want its recipients to know that what they have is not the original, so
 52: that any problems introduced by others will not reflect on the original
 53: authors' reputations.

 55:   Finally, any free program is threatened constantly by software
 56: patents.  We wish to avoid the danger that redistributors of a free
 57: program will individually obtain patent licenses, in effect making the
 58: program proprietary.  To prevent this, we have made it clear that any
 59: patent must be licensed for everyone's free use or not licensed at all.

 61:   The precise terms and conditions for copying, distribution and
 62: modification follow.
 63:  
 64:                     GNU GENERAL PUBLIC LICENSE
 65:    TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION

 67:   0. This License applies to any program or other work which contains
 68: a notice placed by the copyright holder saying it may be distributed
 69: under the terms of this General Public License.  The "Program", below,
 70: refers to any such program or work, and a "work based on the Program"
 71: means either the Program or any derivative work under copyright law:
 72: that is to say, a work containing the Program or a portion of it,
 73: either verbatim or with modifications and/or translated into another
 74: language.  (Hereinafter, translation is included without limitation in
 75: the term "modification".)  Each licensee is addressed as "you".

 77: Activities other than copying, distribution and modification are not
 78: covered by this License; they are outside its scope.  The act of
 79: running the Program is not restricted, and the output from the Program
 80: is covered only if its contents constitute a work based on the
 81: Program (independent of having been made by running the Program).
 82: Whether that is true depends on what the Program does.

 84:   1. You may copy and distribute verbatim copies of the Program's
 85: source code as you receive it, in any medium, provided that you
 86: conspicuously and appropriately publish on each copy an appropriate
 87: copyright notice and disclaimer of warranty; keep intact all the
 88: notices that refer to this License and to the absence of any warranty;
 89: and give any other recipients of the Program a copy of this License
 90: along with the Program.

 92: You may charge a fee for the physical act of transferring a copy, and
 93: you may at your option offer warranty protection in exchange for a fee.

 95:   2. You may modify your copy or copies of the Program or any portion
 96: of it, thus forming a work based on the Program, and copy and
 97: distribute such modifications or work under the terms of Section 1
 98: above, provided that you also meet all of these conditions:

100:     a) You must cause the modified files to carry prominent notices
101:     stating that you changed the files and the date of any change.

103:     b) You must cause any work that you distribute or publish, that in
104:     whole or in part contains or is derived from the Program or any
105:     part thereof, to be licensed as a whole at no charge to all third
106:     parties under the terms of this License.

108:     c) If the modified program normally reads commands interactively
109:     when run, you must cause it, when started running for such
110:     interactive use in the most ordinary way, to print or display an
111:     announcement including an appropriate copyright notice and a
112:     notice that there is no warranty (or else, saying that you provide
113:     a warranty) and that users may redistribute the program under
114:     these conditions, and telling the user how to view a copy of this
115:     License.  (Exception: if the Program itself is interactive but
116:     does not normally print such an announcement, your work based on
117:     the Program is not required to print an announcement.)
118:  
119: These requirements apply to the modified work as a whole.  If
120: identifiable sections of that work are not derived from the Program,
121: and can be reasonably considered independent and separate works in
122: themselves, then this License, and its terms, do not apply to those
123: sections when you distribute them as separate works.  But when you
124: distribute the same sections as part of a whole which is a work based
125: on the Program, the distribution of the whole must be on the terms of
126: this License, whose permissions for other licensees extend to the
127: entire whole, and thus to each and every part regardless of who wrote it.

129: Thus, it is not the intent of this section to claim rights or contest
130: your rights to work written entirely by you; rather, the intent is to
131: exercise the right to control the distribution of derivative or
132: collective works based on the Program.

134: In addition, mere aggregation of another work not based on the Program
135: with the Program (or with a work based on the Program) on a volume of
136: a storage or distribution medium does not bring the other work under
137: the scope of this License.

139:   3. You may copy and distribute the Program (or a work based on it,
140: under Section 2) in object code or executable form under the terms of
141: Sections 1 and 2 above provided that you also do one of the following:

143:     a) Accompany it with the complete corresponding machine-readable
144:     source code, which must be distributed under the terms of Sections
145:     1 and 2 above on a medium customarily used for software interchange; or,

147:     b) Accompany it with a written offer, valid for at least three
148:     years, to give any third party, for a charge no more than your
149:     cost of physically performing source distribution, a complete
150:     machine-readable copy of the corresponding source code, to be
151:     distributed under the terms of Sections 1 and 2 above on a medium
152:     customarily used for software interchange; or,

154:     c) Accompany it with the information you received as to the offer
155:     to distribute corresponding source code.  (This alternative is
156:     allowed only for noncommercial distribution and only if you
157:     received the program in object code or executable form with such
158:     an offer, in accord with Subsection b above.)

160: The source code for a work means the preferred form of the work for
161: making modifications to it.  For an executable work, complete source
162: code means all the source code for all modules it contains, plus any
163: associated interface definition files, plus the scripts used to
164: control compilation and installation of the executable.  However, as a
165: special exception, the source code distributed need not include
166: anything that is normally distributed (in either source or binary
167: form) with the major components (compiler, kernel, and so on) of the
168: operating system on which the executable runs, unless that component
169: itself accompanies the executable.

171: If distribution of executable or object code is made by offering
172: access to copy from a designated place, then offering equivalent
173: access to copy the source code from the same place counts as
174: distribution of the source code, even though third parties are not
175: compelled to copy the source along with the object code.
176:  
177:   4. You may not copy, modify, sublicense, or distribute the Program
178: except as expressly provided under this License.  Any attempt
179: otherwise to copy, modify, sublicense or distribute the Program is
180: void, and will automatically terminate your rights under this License.
181: However, parties who have received copies, or rights, from you under
182: this License will not have their licenses terminated so long as such
183: parties remain in full compliance.

185:   5. You are not required to accept this License, since you have not
186: signed it.  However, nothing else grants you permission to modify or
187: distribute the Program or its derivative works.  These actions are
188: prohibited by law if you do not accept this License.  Therefore, by
189: modifying or distributing the Program (or any work based on the
190: Program), you indicate your acceptance of this License to do so, and
191: all its terms and conditions for copying, distributing or modifying
192: the Program or works based on it.

194:   6. Each time you redistribute the Program (or any work based on the
195: Program), the recipient automatically receives a license from the
196: original licensor to copy, distribute or modify the Program subject to
197: these terms and conditions.  You may not impose any further
198: restrictions on the recipients' exercise of the rights granted herein.
199: You are not responsible for enforcing compliance by third parties to
200: this License.

202:   7. If, as a consequence of a court judgment or allegation of patent
203: infringement or for any other reason (not limited to patent issues),
204: conditions are imposed on you (whether by court order, agreement or
205: otherwise) that contradict the conditions of this License, they do not
206: excuse you from the conditions of this License.  If you cannot
207: distribute so as to satisfy simultaneously your obligations under this
208: License and any other pertinent obligations, then as a consequence you
209: may not distribute the Program at all.  For example, if a patent
210: license would not permit royalty-free redistribution of the Program by
211: all those who receive copies directly or indirectly through you, then
212: the only way you could satisfy both it and this License would be to
213: refrain entirely from distribution of the Program.

215: If any portion of this section is held invalid or unenforceable under
216: any particular circumstance, the balance of the section is intended to
217: apply and the section as a whole is intended to apply in other
218: circumstances.

220: It is not the purpose of this section to induce you to infringe any
221: patents or other property right claims or to contest validity of any
222: such claims; this section has the sole purpose of protecting the
223: integrity of the free software distribution system, which is
224: implemented by public license practices.  Many people have made
225: generous contributions to the wide range of software distributed
226: through that system in reliance on consistent application of that
227: system; it is up to the author/donor to decide if he or she is willing
228: to distribute software through any other system and a licensee cannot
229: impose that choice.

231: This section is intended to make thoroughly clear what is believed to
232: be a consequence of the rest of this License.
233:  
234:   8. If the distribution and/or use of the Program is restricted in
235: certain countries either by patents or by copyrighted interfaces, the
236: original copyright holder who places the Program under this License
237: may add an explicit geographical distribution limitation excluding
238: those countries, so that distribution is permitted only in or among
239: countries not thus excluded.  In such case, this License incorporates
240: the limitation as if written in the body of this License.

242:   9. The Free Software Foundation may publish revised and/or new versions
243: of the General Public License from time to time.  Such new versions will
244: be similar in spirit to the present version, but may differ in detail to
245: address new problems or concerns.

247: Each version is given a distinguishing version number.  If the Program
248: specifies a version number of this License which applies to it and "any
249: later version", you have the option of following the terms and conditions
250: either of that version or of any later version published by the Free
251: Software Foundation.  If the Program does not specify a version number of
252: this License, you may choose any version ever published by the Free Software
253: Foundation.

255:   10. If you wish to incorporate parts of the Program into other free
256: programs whose distribution conditions are different, write to the author
257: to ask for permission.  For software which is copyrighted by the Free
258: Software Foundation, write to the Free Software Foundation; we sometimes
259: make exceptions for this.  Our decision will be guided by the two goals
260: of preserving the free status of all derivatives of our free software and
261: of promoting the sharing and reuse of software generally.

263:                             NO WARRANTY

265:   11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
266: FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
267: OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
268: PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
269: OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
270: MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
271: TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
272: PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
273: REPAIR OR CORRECTION.

275:   12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
276: WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
277: REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
278: INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
279: OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
280: TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
281: YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
282: PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
283: POSSIBILITY OF SUCH DAMAGES.

285:                      END OF TERMS AND CONDITIONS
286:  
287:         Appendix: How to Apply These Terms to Your New Programs

289:   If you develop a new program, and you want it to be of the greatest
290: possible use to the public, the best way to achieve this is to make it
291: free software which everyone can redistribute and change under these terms.

293:   To do so, attach the following notices to the program.  It is safest
294: to attach them to the start of each source file to most effectively
295: convey the exclusion of warranty; and each file should have at least
296: the "copyright" line and a pointer to where the full notice is found.

298:     <one line to give the program's name and a brief idea of what it does.>
299:     Copyright (C) 19yy  <name of author>

301:     This program is free software; you can redistribute it and/or modify
302:     it under the terms of the GNU General Public License as published by
303:     the Free Software Foundation; either version 2 of the License, or
304:     (at your option) any later version.

306:     This program is distributed in the hope that it will be useful,
307:     but WITHOUT ANY WARRANTY; without even the implied warranty of
308:     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
309:     GNU General Public License for more details.

311:     You should have received a copy of the GNU General Public License
312:     along with this program; if not, write to the Free Software
313:     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

315: Also add information on how to contact you by electronic and paper mail.

317: If the program is interactive, make it output a short notice like this
318: when it starts in an interactive mode:

320:     Gnomovision version 69, Copyright (C) 19yy name of author
321:     Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
322:     This is free software, and you are welcome to redistribute it
323:     under certain conditions; type `show c' for details.

325: The hypothetical commands `show w' and `show c' should show the appropriate
326: parts of the General Public License.  Of course, the commands you use may
327: be called something other than `show w' and `show c'; they could even be
328: mouse-clicks or menu items--whatever suits your program.

330: You should also get your employer (if you work as a programmer) or your
331: school, if any, to sign a "copyright disclaimer" for the program, if
332: necessary.  Here is a sample; alter the names:

334:   Yoyodyne, Inc., hereby disclaims all copyright interest in the program
335:   `Gnomovision' (which makes passes at compilers) written by James Hacker.

337:   <signature of Ty Coon>, 1 April 1989
338:   Ty Coon, President of Vice

340: This General Public License does not permit incorporating your program into
341: proprietary programs.  If your program is a subroutine library, you may
342: consider it more useful to permit linking proprietary applications with the
343: library.  If this is what you want to do, use the GNU Library General
344: Public License instead of this License.

346: */
347:  #include petsc.h

349: static PetscErrorCode SPARSEKIT2qsplit(PetscScalar *a,PetscInt *ind,PetscInt *n,PetscInt *ncut)
350: {
351:     /* System generated locals */
352:     PetscInt i__1;
353:     PetscScalar d__1;

355:     /* Local variables */
356:     PetscInt last,itmp,j,first;
357:     PetscReal abskey;
358:     PetscInt mid;
359:     PetscScalar tmp;

361: /* -----------------------------------------------------------------------
362:  */
363: /*     does a quick-sort split of a real array. */
364: /*     on input a(1:n). is a real array */
365: /*     on output a(1:n) is permuted such that its elements satisfy: */

367: /*     abs(a(i)) .ge. abs(a(ncut)) for i .lt. ncut and */
368: /*     abs(a(i)) .le. abs(a(ncut)) for i .gt. ncut */

370: /*    ind(1:n) is an integer array which permuted in the same way as a(*).
371: */
372: /* -----------------------------------------------------------------------
373:  */
374: /* ----- */
375:     /* Parameter adjustments */
376:     --ind;
377:     --a;

379:     /* Function Body */
380:     first = 1;
381:     last = *n;
382:     if (*ncut < first || *ncut > last) {
383:         return 0;
384:     }

386: /*     outer loop -- while mid .ne. ncut do */

388: L1:
389:     mid = first;
390:     abskey = (d__1 = a[mid],PetscAbsScalar(d__1));
391:     i__1 = last;
392:     for (j = first + 1; j <= i__1; ++j) {
393:         if ((d__1 = a[j],PetscAbsScalar(d__1)) > abskey) {
394:             ++mid;
395: /*     interchange */
396:             tmp = a[mid];
397:             itmp = ind[mid];
398:             a[mid] = a[j];
399:             ind[mid] = ind[j];
400:             a[j] = tmp;
401:             ind[j] = itmp;
402:         }
403: /* L2: */
404:     }

406: /*     interchange */

408:     tmp = a[mid];
409:     a[mid] = a[first];
410:     a[first] = tmp;

412:     itmp = ind[mid];
413:     ind[mid] = ind[first];
414:     ind[first] = itmp;

416: /*     test for while loop */

418:     if (mid == *ncut) {
419:         return 0;
420:     }
421:     if (mid > *ncut) {
422:         last = mid - 1;
423:     } else {
424:         first = mid + 1;
425:     }
426:     goto L1;
427: /* ----------------end-of-qsplit------------------------------------------
428:  */
429: /* -----------------------------------------------------------------------
430:  */
431: } /* qsplit_ */


434: /* ---------------------------------------------------------------------- */
435: PetscErrorCode SPARSEKIT2ilutp(PetscInt *n,PetscScalar *a,PetscInt *ja,PetscInt * ia,PetscInt *lfil,PetscReal droptol,PetscReal *permtol,PetscInt *mbloc,PetscScalar *alu,
436:         PetscInt *jlu,PetscInt *ju,PetscInt *iwk,PetscScalar *w,PetscInt *jw,  PetscInt *iperm,PetscErrorCode *ierr)
437: {
438:     /* System generated locals */
439:     PetscInt i__1,i__2;
440:     PetscScalar d__1;

442:     /* Local variables */
443:     PetscScalar fact;
444:     PetscInt lenl,imax,lenu,icut,jpos;
445:     PetscReal xmax;
446:     PetscInt jrow;
447:     PetscReal xmax0;
448:     PetscInt i,j,k;
449:     PetscScalar s,t;
450:     PetscInt j_1,j2;
451:     PetscReal tnorm,t1;
452:     PetscInt ii,jj;
453:     PetscInt ju0,len;
454:     PetscScalar tmp;

456: /* -----------------------------------------------------------------------
457:  */
458: /*     implicit none */
459: /* ----------------------------------------------------------------------*
460:  */
461: /*       *** ILUTP preconditioner -- ILUT with pivoting  ***            * 
462: */
463: /*      incomplete LU factorization with dual truncation mechanism      * 
464: */
465: /* ----------------------------------------------------------------------*
466:  */
467: /* author Yousef Saad *Sep 8, 1993 -- Latest revision, August 1996.     * 
468: */
469: /* ----------------------------------------------------------------------*
470:  */
471: /* on entry: */
472: /* ========== */
473: /* n       = integer. The dimension of the matrix A. */

475: /* a,ja,ia = matrix stored in Compressed Sparse Row format. */
476: /*           ON RETURN THE COLUMNS OF A ARE PERMUTED. SEE BELOW FOR */
477: /*           DETAILS. */

479: /* lfil    = integer. The fill-in parameter. Each row of L and each row */

481: /*           of U will have a maximum of lfil elements (excluding the */
482: /*           diagonal element). lfil must be .ge. 0. */
483: /*           ** WARNING: THE MEANING OF LFIL HAS CHANGED WITH RESPECT TO 
484: */
485: /*           EARLIER VERSIONS. */

487: /* droptol = real*8. Sets the threshold for dropping small terms in the */

489: /*           factorization. See below for details on dropping strategy. */


492: /* lfil    = integer. The fill-in parameter. Each row of L and */
493: /*           each row of U will have a maximum of lfil elements. */
494: /*           WARNING: THE MEANING OF LFIL HAS CHANGED WITH RESPECT TO */
495: /*           EARLIER VERSIONS. */
496: /*           lfil must be .ge. 0. */

498: /* permtol = tolerance ratio used to  determne whether or not to permute 
499: */
500: /*           two columns.  At step i columns i and j are permuted when */

502: /*                     abs(a(i,j))*permtol .gt. abs(a(i,i)) */

504: /*           [0 --> never permute; good values 0.1 to 0.01] */

506: /* mbloc   = if desired, permuting can be done only within the diagonal */

508: /*           blocks of size mbloc. Useful for PDE problems with several */

510: /*           degrees of freedom.. If feature not wanted take mbloc=n. */


513: /* iwk     = integer. The lengths of arrays alu and jlu. If the arrays */
514: /*           are not big enough to store the ILU factorizations, ilut */
515: /*           will stop with an error message. */

517: /* On return: */
518: /* =========== */

520: /* alu,jlu = matrix stored in Modified Sparse Row (MSR) format containing 
521: */
522: /*           the L and U factors together. The diagonal (stored in */
523: /*           alu(1:n)) is inverted. Each i-th row of the alu,jlu matrix 
524: */
525: /*           contains the i-th row of L (excluding the diagonal entry=1) 
526: */
527: /*           followed by the i-th row of U. */

529: /* ju      = integer array of length n containing the pointers to */
530: /*           the beginning of each row of U in the matrix alu,jlu. */

532: /* iperm   = contains the permutation arrays. */
533: /*           iperm(1:n) = old numbers of unknowns */
534: /*           iperm(n+1:2*n) = reverse permutation = new unknowns. */

536: /* integer. Error message with the following meaning. */
537: /*           0    --> successful return. */
538: /*           ierr .gt. 0  --> zero pivot encountered at step number ierr. 
539: */
540: /*           -1   --> Error. input matrix may be wrong. */
541: /*                            (The elimination process has generated a */
542: /*                            row in L or U whose length is .gt.  n.) */
543: /*           -2   --> The matrix L overflows the array al. */
544: /*           -3   --> The matrix U overflows the array alu. */
545: /*           -4   --> Illegal value for lfil. */
546: /*           -5   --> zero row encountered. */

548: /* work arrays: */
549: /* ============= */
550: /* jw      = integer work array of length 2*n. */
551: /* w       = real work array of length n */

553: /* IMPORTANR NOTE: */
554: /* -------------- */
555: /* TO AVOID PERMUTING THE SOLUTION VECTORS ARRAYS FOR EACH LU-SOLVE, */
556: /* THE MATRIX A IS PERMUTED ON RETURN. [all column indices are */
557: /* changed]. SIMILARLY FOR THE U MATRIX. */
558: /* To permute the matrix back to its original state use the loop: */

560: /*      do k=ia(1), ia(n+1)-1 */
561: /*         ja(k) = iperm(ja(k)) */
562: /*      enddo */

564: /* -----------------------------------------------------------------------
565:  */
566: /*     local variables */


569:     /* Parameter adjustments */
570:     --iperm;
571:     --jw;
572:     --w;
573:     --ju;
574:     --jlu;
575:     --alu;
576:     --ia;
577:     --ja;
578:     --a;

580:     /* Function Body */
581:     if (*lfil < 0) {
582:         goto L998;
583:     }
584: /* -----------------------------------------------------------------------
585:  */
586: /*     initialize ju0 (points to next element to be added to alu,jlu) */
587: /*     and pointer array. */
588: /* -----------------------------------------------------------------------
589:  */
590:     ju0 = *n + 2;
591:     jlu[1] = ju0;

593: /*  integer PetscReal pointer array. */

595:     i__1 = *n;
596:     for (j = 1; j <= i__1; ++j) {
597:         jw[*n + j] = 0;
598:         iperm[j] = j;
599:         iperm[*n + j] = j;
600: /* L1: */
601:     }
602: /* -----------------------------------------------------------------------
603:  */
604: /*     beginning of main loop. */
605: /* -----------------------------------------------------------------------
606:  */
607:     i__1 = *n;
608:     for (ii = 1; ii <= i__1; ++ii) {
609:         j_1 = ia[ii];
610:         j2 = ia[ii + 1] - 1;
611:         tnorm = 0.;
612:         i__2 = j2;
613:         for (k = j_1; k <= i__2; ++k) {
614:             tnorm += (d__1 = a[k], PetscAbsScalar(d__1));
615: /* L501: */
616:         }
617:         if (!tnorm) {
618:             goto L999;
619:         }
620:         tnorm /= j2 - j_1 + 1;

622: /*     unpack L-part and U-part of row of A in arrays  w  -- */

624:         lenu = 1;
625:         lenl = 0;
626:         jw[ii] = ii;
627:         w[ii] = (float)0.;
628:         jw[*n + ii] = ii;

630:         i__2 = j2;
631:         for (j = j_1; j <= i__2; ++j) {
632:             k = iperm[*n + ja[j]];
633:             t = a[j];
634:             if (k < ii) {
635:                 ++lenl;
636:                 jw[lenl] = k;
637:                 w[lenl] = t;
638:                 jw[*n + k] = lenl;
639:             } else if (k == ii) {
640:                 w[ii] = t;
641:             } else {
642:                 ++lenu;
643:                 jpos = ii + lenu - 1;
644:                 jw[jpos] = k;
645:                 w[jpos] = t;
646:                 jw[*n + k] = jpos;
647:             }
648: /* L170: */
649:         }
650:         jj = 0;
651:         len = 0;

653: /*     eliminate previous rows */

655: L150:
656:         ++jj;
657:         if (jj > lenl) {
658:             goto L160;
659:         }
660: /* ------------------------------------------------------------------
661: ----- */
662: /*     in order to do the elimination in the correct order we must sel
663: ect */
664: /*     the smallest column index among jw(k), k=jj+1, ..., lenl. */
665: /* ------------------------------------------------------------------
666: ----- */
667:         jrow = jw[jj];
668:         k = jj;

670: /*     determine smallest column index */

672:         i__2 = lenl;
673:         for (j = jj + 1; j <= i__2; ++j) {
674:             if (jw[j] < jrow) {
675:                 jrow = jw[j];
676:                 k = j;
677:             }
678: /* L151: */
679:         }

681:         if (k != jj) {
682: /*     exchange in jw */
683:             j = jw[jj];
684:             jw[jj] = jw[k];
685:             jw[k] = j;
686: /*     exchange in jr */
687:             jw[*n + jrow] = jj;
688:             jw[*n + j] = k;
689: /*     exchange in w */
690:             s = w[jj];
691:             w[jj] = w[k];
692:             w[k] = s;
693:         }

695: /*     zero out element in row by resetting jw(n+jrow) to zero. */

697:         jw[*n + jrow] = 0;

699: /*     get the multiplier for row to be eliminated: jrow */

701:         fact = w[jj] * alu[jrow];

703: /*     drop term if small */

705:         if (PetscAbsScalar(fact) <= droptol) {
706:             goto L150;
707:         }

709: /*     combine current row and row jrow */

711:         i__2 = jlu[jrow + 1] - 1;
712:         for (k = ju[jrow]; k <= i__2; ++k) {
713:             s = fact * alu[k];
714: /*     new column number */
715:             j = iperm[*n + jlu[k]];
716:             jpos = jw[*n + j];
717:             if (j >= ii) {

719: /*     dealing with upper part. */

721:                 if (!jpos) {

723: /*     this is a fill-in element */

725:                     ++lenu;
726:                     i = ii + lenu - 1;
727:                     if (lenu > *n) {
728:                         goto L995;
729:                     }
730:                     jw[i] = j;
731:                     jw[*n + j] = i;
732:                     w[i] = -s;
733:                 } else {
734: /*     no fill-in element -- */
735:                     w[jpos] -= s;
736:                 }
737:             } else {

739: /*     dealing with lower part. */

741:                 if (!jpos) {

743: /*     this is a fill-in element */

745:                     ++lenl;
746:                     if (lenl > *n) {
747:                         goto L995;
748:                     }
749:                     jw[lenl] = j;
750:                     jw[*n + j] = lenl;
751:                     w[lenl] = -s;
752:                 } else {

754: /*     this is not a fill-in element */

756:                     w[jpos] -= s;
757:                 }
758:             }
759: /* L203: */
760:         }

762: /*     store this pivot element -- (from left to right -- no danger of
763:  */
764: /*     overlap with the working elements in L (pivots). */

766:         ++len;
767:         w[len] = fact;
768:         jw[len] = jrow;
769:         goto L150;
770: L160:

772: /*     reset double-pointer to zero (U-part) */

774:         i__2 = lenu;
775:         for (k = 1; k <= i__2; ++k) {
776:             jw[*n + jw[ii + k - 1]] = 0;
777: /* L308: */
778:         }

780: /*     update L-matrix */

782:         lenl = len;
783:         len = PetscMin(lenl,*lfil);

785: /*     sort by quick-split */

787:         SPARSEKIT2qsplit(&w[1], &jw[1], &lenl, &len);

789: /*     store L-part -- in original coordinates .. */

791:         i__2 = len;
792:         for (k = 1; k <= i__2; ++k) {
793:             if (ju0 > *iwk) {
794:                 goto L996;
795:             }
796:             alu[ju0] = w[k];
797:             jlu[ju0] = iperm[jw[k]];
798:             ++ju0;
799: /* L204: */
800:         }

802: /*     save pointer to beginning of row ii of U */

804:         ju[ii] = ju0;

806: /*     update U-matrix -- first apply dropping strategy */

808:         len = 0;
809:         i__2 = lenu - 1;
810:         for (k = 1; k <= i__2; ++k) {
811:             if ((d__1 = w[ii + k], PetscAbsScalar(d__1)) > droptol * tnorm) {
812:                 ++len;
813:                 w[ii + len] = w[ii + k];
814:                 jw[ii + len] = jw[ii + k];
815:             }
816:         }
817:         lenu = len + 1;
818:         len = PetscMin(lenu,*lfil);
819:         i__2 = lenu - 1;
820:         SPARSEKIT2qsplit(&w[ii + 1], &jw[ii + 1], &i__2, &len);

822: /*     determine next pivot -- */

824:         imax = ii;
825:         xmax = (d__1 = w[imax], PetscAbsScalar(d__1));
826:         xmax0 = xmax;
827:         icut = ii - 1 + *mbloc - (ii - 1) % *mbloc;
828:         i__2 = ii + len - 1;
829:         for (k = ii + 1; k <= i__2; ++k) {
830:             t1 = (d__1 = w[k], PetscAbsScalar(d__1));
831:             if (t1 > xmax && t1 * *permtol > xmax0 && jw[k] <= icut) {
832:                 imax = k;
833:                 xmax = t1;
834:             }
835:         }

837: /*     exchange w's */

839:         tmp = w[ii];
840:         w[ii] = w[imax];
841:         w[imax] = tmp;

843: /*     update iperm and reverse iperm */

845:         j = jw[imax];
846:         i = iperm[ii];
847:         iperm[ii] = iperm[j];
848:         iperm[j] = i;

850: /*     reverse iperm */

852:         iperm[*n + iperm[ii]] = ii;
853:         iperm[*n + iperm[j]] = j;
854: /* ------------------------------------------------------------------
855: ----- */

857:         if (len + ju0 > *iwk) {
858:             goto L997;
859:         }

861: /*     copy U-part in original coordinates */

863:         i__2 = ii + len - 1;
864:         for (k = ii + 1; k <= i__2; ++k) {
865:             jlu[ju0] = iperm[jw[k]];
866:             alu[ju0] = w[k];
867:             ++ju0;
868: /* L302: */
869:         }

871: /*     store inverse of diagonal element of u */

873:         if (w[ii] == 0.0) {
874:             w[ii] = (droptol + 1e-4) * tnorm;
875:         }
876:         alu[ii] = 1. / w[ii];

878: /*     update pointer to beginning of next row of U. */

880:         jlu[ii + 1] = ju0;
881: /* ------------------------------------------------------------------
882: ----- */
883: /*     end main loop */
884: /* ------------------------------------------------------------------
885: ----- */
886: /* L500: */
887:     }

889: /*     permute all column indices of LU ... */

891:     i__1 = jlu[*n + 1] - 1;
892:     for (k = jlu[1]; k <= i__1; ++k) {
893:         jlu[k] = iperm[*n + jlu[k]];
894:     }

896: /*     ...and of A */

898:     i__1 = ia[*n + 1] - 1;
899:     for (k = ia[1]; k <= i__1; ++k) {
900:         ja[k] = iperm[*n + ja[k]];
901:     }

903:     *0;
904:     return 0;

906: /*     incomprehensible error. Matrix must be wrong. */

908: L995:
909:     *-1;
910:     return 0;

912: /*     insufficient storage in L. */

914: L996:
915:     *-2;
916:     return 0;

918: /*     insufficient storage in U. */

920: L997:
921:     *-3;
922:     return 0;

924: /*     illegal lfil entered. */

926: L998:
927:     *-4;
928:     return 0;

930: /*     zero row encountered */

932: L999:
933:     *-5;
934:     return 0;
935: /* ----------------end-of-ilutp-------------------------------------------
936:  */
937: /* -----------------------------------------------------------------------
938:  */
939: } /* ilutp_ */