SUBROUTINE UMD2F0 (N, NZ, CP, XX, XSIZE, II, ISIZE, XTAIL, $ ITAIL, IUSE, XUSE, NZOFF, NBLKS, ICNTL, CNTL, INFO, $ RINFO, PRESRV, AP, AI, AX, AN, ANZ, KEEP, NE) INTEGER N, NZ, ISIZE, II (ISIZE), ICNTL (20), INFO (40), $ CP (N+1), XSIZE, XTAIL, ITAIL, IUSE, XUSE, AN, ANZ, $ AP (AN+1), AI (ANZ), KEEP (20), NZOFF, NBLKS, NE LOGICAL PRESRV DOUBLE PRECISION $ XX (XSIZE), AX (ANZ) DOUBLE PRECISION $ CNTL (10), RINFO (20) C=== UMD2F0 ============================================================ C C Unsymmetric-pattern MultiFrontal Package (UMFPACK). Version 2.2d C Copyright (C) 1997, Timothy A. Davis, University of Florida, USA. C ALL RIGHTS RESERVED. C Joint work with Iain S. Duff, Rutherford Appleton Laboratory, UK. C July 7, 1997. Work supported by the National Science Foundation C (DMS-9223088 and DMS-9504974) and the State of Florida; and by CRAY C Research Inc. through the allocation of supercomputing resources. C*********************************************************************** C* NOTICE: "The UMFPACK Package may be used SOLELY for educational, * C* research, and benchmarking purposes by non-profit organizations and * C* the U.S. government. Commercial and other organizations may make * C* use of UMFPACK SOLELY for benchmarking purposes only. UMFPACK may * C* be modified by or on behalf of the User for such use but at no time * C* shall UMFPACK or any such modified version of UMFPACK become the * C* property of the User. UMFPACK is provided without warranty of any * C* kind, either expressed or implied. Neither the Authors nor their * C* employers shall be liable for any direct or consequential loss or * C* damage whatsoever arising out of the use or misuse of UMFPACK by * C* the User. UMFPACK must not be sold. You may make copies of * C* UMFPACK, but this NOTICE and the Copyright notice must appear in * C* all copies. Any other use of UMFPACK requires written permission. * C* Your use of UMFPACK is an implicit agreement to these conditions." * C* * C* The MA38 Package in Release 12 of the Harwell Subroutine Library * C* (HSL) has equivalent functionality (and identical calling interface)* C* as UMFPACK (the HSL has single and double precision versions only, * C* however). It is available for commercial use. Technical reports, * C* information on HSL, and matrices are available via the World Wide * C* Web at http://www.cis.rl.ac.uk/struct/ARCD/NUM.html, or by * C* anonymous ftp at seamus.cc.rl.ac.uk/pub. Also contact Dr. Scott * C* Roberts, Harwell Subroutine Library, B 552, AEA Technology, * C* Harwell, Didcot, Oxon OX11 0RA, England. * C* telephone (44) 1235 434988, fax (44) 1235 434136 * C* email Scott.Roberts@aeat.co.uk, who will provide details of price * C* and conditions of use. * C*********************************************************************** C======================================================================= C NOT USER-CALLABLE. C======================================================================= C DESCRIPTION: C======================================================================= C C Factorize an unsymmetric sparse matrix in column-form, optionally C permuting the matrix to upper block triangular form and factorizing C each diagonal block. C======================================================================= C INPUT: C======================================================================= C C n: order of matrix C nz: entries in matrix, after removing duplicates C and invalid entries. C ne: number of triplets, unchanged from UMD2FA C Cp (1..n+1): column pointers of input matrix C presrv: if true then preserve original matrix C xsize: size of XX C isize: size of II C iuse: memory usage in Index on input C xuse: memory usage in Value on input C Icntl: integer control parameters, see UMD21I C Cntl: real control parameters, see UMD21I C Keep (6..8): integer control parameters, see UMD21I C C if presrv is true: C an: = n, order of preserved matrix C anz: = anz, order of preserved matrix C Ap (1..an+1): column pointers of preserved matrix C Ai (1..nz): row indices of preserved matrix C Ax (1..nz): values of preserved matrix C II: unused on input C XX: unused on input C else C an: 1 C anz: 1 C Ap: unused C Ai: unused C Ax: unused C II (1..nz): row indices of input matrix C XX (1..nz): values of input matrix C======================================================================= C OUTPUT: C======================================================================= C C XX (xtail ... xsize), xtail: C C LU factors are located in XX (xtail ... xsize), C including values in off-diagonal part if matrix C was permuted to block triangular form. C C II (itail ... isize), itail: C C LU factors are located in II (itail ... isize), C including pattern, row and column permutations, C block triangular information, etc. See umf2fa C for more information. C C Info: integer informational output, see UMD2FA C Rinfo: real informational output, see UMD2FA C C iuse: memory usage in Index on output C xuse: memory usage in Value on output C C nzoff: entries in off-diagonal part (0 if BTF not used) C nblks: number of diagonal blocks (1 if BTF not used) C======================================================================= C SUBROUTINES AND FUNCTIONS CALLED / CALLED BY: C======================================================================= C C called by subroutine: UMD2FA C subroutines called: UMD2ER, UMD2FB, UMD2F1, UMD2OF C functions called: MAX INTRINSIC MAX C======================================================================= C LOCAL SCALARS: C======================================================================= INTEGER KN, NZDIA, BLKPP, LUBLPP, P, OFFIP, XHEAD, ROW, $ OFFXP, OFFPP, IHEAD, K1, K2, BLK, PRP, P2, CPERMP, $ RPERMP, NSGLTN, NPIV, MNZ, NSYM, K, COL, RMAX, CMAX, $ TOTNLU, XRMAX, XRUSE LOGICAL TRYBTF, IOUT, XOUT DOUBLE PRECISION $ A C Allocated array pointers: C ------------------------- C blkpp: Blkp (1..nblks+1) array located in II (blkpp..blkp+nblks) C lublpp: LUblkp (1..nblks) array loc. in II (lublpp..lublpp+nblks-1) C offip: Offi (1..nzoff) array located in II (offip..offip+nzoff-1) C offxp: Offx (1..nzoff) array located in XX (offxp..offxp+nzoff-1) C offpp: Offp (1..n+1) array located in II (offpp..offpp+n) C cpermp: Cperm (1..n) array located in II (cpermp..cpermp+n-1) C rpermp: Rperm (1..n) array located in II (rpermp..rpermp+n-1) C prp: Pr (1..n) work array located in II (prp..prp+n-1) C C BTF information: C ---------------- C k1: starting index of diagonal block being factorized C k2: ending index of diagonal block being factorized C kn: the order of the diagonal block being factorized C blk: block number of diagonal block being factorized C trybtf: true if BTF is to be attempted (= Icntl (4) .eq. 1) C nzdia: number of entries in diagonal blocks (= nz if BTF not used) C nsgltn: number of 1-by-1 diagonal blocks ("singletons") C npiv: number of numerically valid singletons C a: numerical value of a singleton C mnz: nzoff C C Memory usage: C ------------- C xhead: XX (1..xhead-1) is in use, XX (xhead..xtail-1) is free C ihead: II (1..ihead-1) is in use, II (ihead..itail-1) is free C iout: true if UMD2F1 ran out of integer memory, but did not C set error flag C xout: true if UMD2F2 ran out of integer memory, but did not C set error flag C C Estimated memory for UMD2RF: C ---------------------------- C rmax: largest contribution block is cmax-by-rmax C cmax: " " " " " " " C totnlu: total number of LU arrowheads in all diagonal blocks C xrmax: estimated maximum real memory usage for UMD2RF C xruse: estimated current real memory usage for UMD2RF C C Other: C ------ C k: loop index (kth pivot) C row: row index C col: column index C p: pointer C p2: pointer C nsym: number of symmetric pivots chosen C======================================================================= C EXECUTABLE STATEMENTS: C======================================================================= C----------------------------------------------------------------------- C get input parameters and initialize C----------------------------------------------------------------------- NBLKS = 1 NZOFF = 0 NZDIA = NZ NSGLTN = 0 NPIV = 0 RMAX = 1 CMAX = 1 TOTNLU = 0 IF (PRESRV) THEN C original matrix is not in Cp/II/XX, but in Ap/Ai/Ax: IHEAD = 1 XHEAD = 1 ELSE IHEAD = NZ + 1 XHEAD = NZ + 1 ENDIF ITAIL = ISIZE + 1 XTAIL = XSIZE + 1 C----------------------------------------------------------------------- C allocate permutation arrays: Cperm (1..n) and Rperm (1..n), and C seven scalars: transa, nzoff, nblks, presrv, nz, n, ne C (in that order) at tail of II (in LU factors) C----------------------------------------------------------------------- ITAIL = ITAIL - (2*N+7) IUSE = IUSE + (2*N+7) INFO (18) = MAX (INFO (18), IUSE) INFO (19) = INFO (18) CPERMP = ITAIL RPERMP = CPERMP + N IF (IHEAD .GT. ITAIL) THEN C error return, if not enough integer memory: GO TO 9000 ENDIF C----------------------------------------------------------------------- C Find permutations to block upper triangular form, if requested. C----------------------------------------------------------------------- TRYBTF = ICNTL (4) .EQ. 1 IF (TRYBTF) THEN C ------------------------------------------------------------- C get workspace at tail of II of size 6n+2 C ------------------------------------------------------------- ITAIL = ITAIL - (N+1) OFFPP = ITAIL ITAIL = ITAIL - (5*N+1) P = ITAIL IUSE = IUSE + (6*N+2) INFO (18) = MAX (INFO (18), IUSE) INFO (19) = INFO (18) C ------------------------------------------------------------- IF (PRESRV) THEN C find permutation, but do not convert to BTF form C ------------------------------------------------------------- IF (IHEAD .GT. ITAIL) THEN C error return, if not enough integer memory: GO TO 9000 ENDIF CALL UMD2FB (AX, ANZ, AI, ANZ, N, NZ, NZDIA, NZOFF, $ NBLKS, CP, II (CPERMP), II (RPERMP), II(P), II(P+N), $ II (P+2*N), II (P+3*N), II (P+4*N), II (OFFPP), $ PRESRV, ICNTL) C ------------------------------------------------------------- ELSE C find permutation, convert to BTF form, and discard original C ------------------------------------------------------------- C use additional size nz temporary workspace in II and XX IHEAD = IHEAD + NZ XHEAD = XHEAD + NZ IUSE = IUSE + NZ XUSE = XUSE + NZ INFO (18) = MAX (INFO (18), IUSE) INFO (20) = MAX (INFO (20), XUSE) INFO (19) = INFO (18) INFO (21) = INFO (20) IF (IHEAD .GT. ITAIL .OR. XHEAD .GT. XTAIL) THEN C error return, if not enough integer and/or real memory: GO TO 9000 ENDIF CALL UMD2FB (XX, 2*NZ, II, 2*NZ, N, NZ, NZDIA, NZOFF, $ NBLKS, CP, II (CPERMP), II (RPERMP), II(P), II(P+N), $ II (P+2*N), II (P+3*N), II (P+4*N), II (OFFPP), $ PRESRV, ICNTL) C deallocate extra workspace in II and XX IHEAD = IHEAD - NZ XHEAD = XHEAD - NZ IUSE = IUSE - NZ XUSE = XUSE - NZ ENDIF C ------------------------------------------------------------- C deallocate workspace, and allocate BTF arrays if required C ------------------------------------------------------------- IF (NBLKS .GT. 1) THEN C replace (6*n+2) workspace at tail of II with C Blkp (1..nblks+1) and LUblkp (1..nblks), Offp (1..n+1) BLKPP = OFFPP - (NBLKS+1) LUBLPP = BLKPP - (NBLKS) ITAIL = LUBLPP IUSE = IUSE - (6*N+2) + (2*NBLKS+N+2) ELSE C The matrix is irreducible. There is only one block. C Remove everything at tail of II, except C for the 2*n permutation vectors and the 7 scalars. C (transa, nzoff, nblks, presrv, nz, n, ne). ITAIL = (ISIZE + 1) - (2*N+7) IUSE = IUSE - (6*N+2) ENDIF ENDIF C----------------------------------------------------------------------- C current memory usage: C----------------------------------------------------------------------- C if .not. presrv then C input matrix is now in II (1..nz) and XX (1..nz) C off-diagonal part: in II/XX (1..nzoff) C col pattern: II (Offp (col) ... Offp (col+1)) C col values: XX (Offp (col) ... Offp (col+1)) C diagonal blocks: in II/XX (nzoff+1..nz) C col pattern: II (Cp (col) ... Cp (col+1)) C col values: XX (Cp (col) ... Cp (col+1)) C total: nz+n+1 integers, nz reals C else C input matrix is now in Ai (1..nz) and Ax (1..nz), C in original (non-BTF) order: C col pattern: Ai (Ap (col) ... Ap (col+1)) C col values: Ax (Ap (col) ... Ap (col+1)) C Cp is a size n+1 integer workspace C total: nz+2*(n+1) integers, nz reals C C if (nblks > 1) then C at tail of II (in order): 2*nblks+n+2 C LUblkp (1..nblks) C Blkp (1..nblks+1) C Offp (1..n+1) C total: (2*nblks+n+2) integers C C remainder at tail of II: C Cperm (1..n) C Rperm (1..n) C seven scalars: transa, nzoff, nblks, presrv, nz, n, ne C C Grand total current memory usage (including II,XX,Cp,Ai,Ap,Ax): C C presrv nblks>1 integers, iuse = C F F nz+ (n+1)+(2*n+7) C F T nz+ (n+1)+(2*n+7)+(2*nblks+n+2) C T F nz+2*(n+1)+(2*n+7) C T T nz+2*(n+1)+(2*n+7)+(2*nblks+n+2) C C real usage is xuse = nz C ---------------------------------------------------------------- C get memory usage for next call to UMD2RF C ---------------------------------------------------------------- XRMAX = 2*NE XRUSE = NZ C----------------------------------------------------------------------- C factorization C----------------------------------------------------------------------- IF (NBLKS .EQ. 1) THEN C ------------------------------------------------------------- C factorize the matrix as a single block C ------------------------------------------------------------- CALL UMD2F1 (CP, N, II (CPERMP), II (RPERMP), NZOFF, $ ITAIL, XTAIL, XX, XSIZE, XUSE, II, ITAIL-1, IUSE, $ ICNTL, CNTL, INFO, RINFO, NBLKS, $ AP, AI, AX, PRESRV, 1, AN, ANZ, II, KEEP, $ RMAX, CMAX, TOTNLU, XRMAX, XRUSE, IOUT, XOUT) IF (IOUT .OR. XOUT) THEN C error return, if not enough integer and/or real memory: GO TO 9000 ENDIF IF (INFO (1) .LT. 0) THEN C error return, if error in UMD2F2: GO TO 9010 ENDIF C original matrix has been deallocated IHEAD = 1 XHEAD = 1 C ------------------------------------------------------------- C make the index of the block relative to start of LU factors C ------------------------------------------------------------- II (ITAIL) = 1 ELSE C ------------------------------------------------------------- C factorize the block-upper-triangular form of the matrix C ------------------------------------------------------------- PRP = OFFPP IF (PRESRV) THEN C count the off-diagonal entries during factorization NZOFF = 0 C compute temp inverse permutation in II (prp..prp+n-1) CFPP$ NODEPCHK L DO 10 K = 1, N II (PRP + II (RPERMP+K-1) - 1) = K 10 CONTINUE ENDIF DO 30 BLK = NBLKS, 1, -1 C ---------------------------------------------------------- C factorize the kn-by-kn block, A (k1..k2, k1..k2) C ---------------------------------------------------------- C get k1 and k2, the start and end of this block K1 = II (BLKPP+BLK-1) K2 = II (BLKPP+BLK) - 1 KN = K2-K1+1 IF (.NOT. PRESRV) THEN P = CP (K1) CP (K2+1) = IHEAD ENDIF IF (KN .GT. 1) THEN C ------------------------------------------------------- C factor the block (the block is not a singleton) C ------------------------------------------------------- CALL UMD2F1 (CP (K1), KN, $ II (CPERMP+K1-1), II (RPERMP+K1-1), NZOFF, $ ITAIL, XTAIL, XX, XTAIL-1, XUSE, II, ITAIL-1, $ IUSE, ICNTL, CNTL, INFO, RINFO, NBLKS, $ AP, AI, AX, PRESRV, K1, AN, ANZ, II (PRP), KEEP, $ RMAX, CMAX, TOTNLU, XRMAX, XRUSE, IOUT, XOUT) IF (IOUT .OR. XOUT) THEN C error return, if not enough int. and/or real memory: GO TO 9000 ENDIF IF (INFO (1) .LT. 0) THEN C error return, if error in UMD2F2: GO TO 9010 ENDIF IF (PRESRV) THEN IHEAD = 1 XHEAD = 1 ELSE IHEAD = P XHEAD = P ENDIF C ------------------------------------------------------- C save the location of the LU factors in LUbkp (blk) C ------------------------------------------------------- II (LUBLPP+BLK-1) = ITAIL ELSE C ------------------------------------------------------- C get the value of singleton at A (k1,k1), if it exists C ------------------------------------------------------- A = 0 IF (PRESRV) THEN C find the diagonal entry in the unpermuted matrix COL = II (CPERMP + K1 - 1) DO 20 P2 = AP (COL), AP (COL + 1) - 1 ROW = II (PRP + AI (P2) - 1) IF (ROW .LT. K1) THEN C entry in off-diagonal blocks NZOFF = NZOFF + 1 ELSE A = AX (P2) ENDIF 20 CONTINUE IHEAD = 1 XHEAD = 1 ELSE IF (P .NE. IHEAD) THEN A = XX (P) IHEAD = P XHEAD = P IUSE = IUSE - 1 XUSE = XUSE - 1 XRUSE = XRUSE - 1 ENDIF C ------------------------------------------------------- C store the 1-by-1 LU factors of a singleton C ------------------------------------------------------- NSGLTN = NSGLTN + 1 IF (ABS (A) .EQ. 0) THEN C the diagonal entry is either not present, or present C but numerically zero. This is a singular matrix, C replace with 1-by-1 identity matrix. A = 1 ELSE C increment pivot count NPIV = NPIV + 1 ENDIF XTAIL = XTAIL - 1 C note: if the matrix is not preserved and nonsingular C then we will not run out of memory at this point. XUSE = XUSE + 1 XRUSE = XRUSE + 1 XRMAX = MAX (XRMAX, XRUSE) INFO (20) = MAX (INFO (20), XUSE) INFO (21) = MAX (INFO (21), XUSE) C error return, if not enough real memory: IF (XHEAD .GT. XTAIL) THEN GO TO 9000 ENDIF II (LUBLPP+BLK-1) = -XTAIL XX (XTAIL) = A ENDIF 30 CONTINUE C ------------------------------------------------------------- C make the index of each block relative to start of LU factors C ------------------------------------------------------------- CFPP$ NODEPCHK L DO 40 P = LUBLPP, LUBLPP + NBLKS - 1 IF (II (P) .GT. 0) THEN II (II (P)) = II (II (P)) - XTAIL + 1 II (P) = II (P) - ITAIL + 1 ELSE C this is a singleton II (P) = (-II (P)) - XTAIL + 1 ENDIF 40 CONTINUE C ------------------------------------------------------------- C allocate temporary workspace for Pr (1..n) at head of II C ------------------------------------------------------------- PRP = IHEAD IHEAD = IHEAD + N IUSE = IUSE + N C ------------------------------------------------------------- C allocate a single entry in case the LU factors are empty C ------------------------------------------------------------- IF (NBLKS .EQ. N) THEN C otherwise, arrays in UMD2RF and UMD2SO would have C zero size, which can cause an address fault later on ITAIL = ITAIL - 1 IUSE = IUSE + 1 P2 = ITAIL ENDIF C ------------------------------------------------------------- C allocate permanent copy of off-diagonal blocks C ------------------------------------------------------------- ITAIL = ITAIL - NZOFF OFFIP = ITAIL XTAIL = XTAIL - NZOFF OFFXP = XTAIL IUSE = IUSE + NZOFF XUSE = XUSE + NZOFF XRUSE = XRUSE + NZOFF XRMAX = MAX (XRMAX, XRUSE) INFO (18) = MAX (INFO (18), IUSE) INFO (19) = MAX (INFO (19), IUSE) INFO (20) = MAX (INFO (20), XUSE) INFO (21) = MAX (INFO (21), XUSE) IF (IHEAD .GT. ITAIL .OR. XHEAD .GT. XTAIL) THEN C error return, if not enough integer and/or real memory: GO TO 9000 ENDIF C ------------------------------------------------------------- C re-order the off-diagonal blocks according to pivot perm C ------------------------------------------------------------- C use Cp as temporary work array: MNZ = NZOFF IF (PRESRV) THEN CALL UMD2OF (CP, N, II (RPERMP), II (CPERMP), NZOFF, $ II (OFFPP), II (OFFIP), XX (OFFXP), II (PRP), $ ICNTL, AP, AI, AX, AN, ANZ, PRESRV, NBLKS, II (BLKPP), $ MNZ, 1, INFO, P) ELSE CALL UMD2OF (CP, N, II (RPERMP), II (CPERMP), NZOFF, $ II (OFFPP), II (OFFIP), XX (OFFXP), II (PRP), $ ICNTL, 0, II, XX, 0, MNZ, PRESRV, 0, 0, $ MNZ, 1, INFO, P) ENDIF IF (NBLKS .EQ. N) THEN C zero the only entry in the integer part of the LU factors II (P2) = 0 ENDIF C ------------------------------------------------------------- C deallocate Pr (1..n), and II/XX (1..nzoff) if present C ------------------------------------------------------------- IHEAD = 1 XHEAD = 1 IUSE = IUSE - N IF (.NOT. PRESRV) THEN IUSE = IUSE - NZOFF XUSE = XUSE - NZOFF ENDIF ENDIF C----------------------------------------------------------------------- C normal and error return C----------------------------------------------------------------------- C error return label: 9000 CONTINUE IF (IOUT .OR. IHEAD .GT. ITAIL) THEN C set error flag if not enough integer memory CALL UMD2ER (1, ICNTL, INFO, -3, INFO (19)) ENDIF IF (XOUT .OR. XHEAD .GT. XTAIL) THEN C set error flag if not enough real memory CALL UMD2ER (1, ICNTL, INFO, -4, INFO (21)) ENDIF C error return label, for error from UMD2F2: 9010 CONTINUE INFO (4) = 0 NZDIA = NZ - NZOFF INFO (5) = NZ INFO (6) = NZDIA INFO (7) = NZOFF INFO (8) = NSGLTN INFO (9) = NBLKS INFO (12) = INFO (10) + INFO (11) + N + INFO (7) C Count the number of symmetric pivots chosen. Note that some of C these may have been numerically unacceptable. NSYM = 0 IF (INFO (1) .GE. 0) THEN DO 50 K = 1, N IF (II (CPERMP+K-1) .EQ. II (RPERMP+K-1)) THEN C this kth pivot came from the diagonal of A NSYM = NSYM + 1 ENDIF 50 CONTINUE ENDIF INFO (16) = NSYM INFO (17) = INFO (17) + NPIV RINFO (1) = RINFO (4) + RINFO (5) + RINFO (6) IF (INFO (1) .GE. 0 .AND. INFO (17) .LT. N) THEN C set warning flag if matrix is singular CALL UMD2ER (1, ICNTL, INFO, 4, INFO (17)) ENDIF C ---------------------------------------------------------------- C Determine an upper bound on the amount of integer memory needed C (LINDEX) for a subsequent call to UMD2RF. If block-upper- C triangular-form is not in use (Info (9) is 1), then C this bound is exact. If NE is higher in the call to UMD2RF C than in the call to UMD2FA, then add 3 integers for each C additional entry (including the 2 integers required for the C row and column indices of the additional triplet itself). C This estimate assumes that JOB and TRANSA are the same in C UMD2FA and UMD2RF. C ---------------------------------------------------------------- C (Keep (5) - Keep (4) + 1), is added to Info (22) C in UMD2FA, to complete the computation of the estimate. IF (PRESRV) THEN INFO (22) = MAX (3*NE+2*N+1, NE+3*N+2, $ 2*NZ+4*N+10+RMAX+3*CMAX+4*TOTNLU) ELSE INFO (22) = MAX (3*NE+2*N+1, NE+3*N+2, 2*NZ+3*N+2, $ NZ+3*N+ 9+RMAX+3*CMAX+4*TOTNLU) ENDIF C ---------------------------------------------------------------- C Approximate the amount of real memory needed (LVALUE) for a C subsequent call to UMD2RF. The approximation is an upper bound C on the bare minimum amount needed. Some garbage collection may C occur, but UMD2RF is guaranteed to finish if given an LVALUE of C size Info (23) and if the pattern is the same. If NE is C higher in the call to UMD2RF than in the call to UMD2FA, then C add 2 reals for each additional entry (including the 1 real C required for the value of the additional triplet itself). C This estimate assumes that JOB and TRANSA are the same in C UMD2FA and UMD2RF. C ---------------------------------------------------------------- INFO (23) = XRMAX RETURN END