]> https://gitweb.dealii.org/ - dealii-svn.git/commitdiff
.
authorwolf <wolf@0785d39b-7218-0410-832d-ea1e28bc413d>
Fri, 7 Jun 2002 08:02:14 +0000 (08:02 +0000)
committerwolf <wolf@0785d39b-7218-0410-832d-ea1e28bc413d>
Fri, 7 Jun 2002 08:02:14 +0000 (08:02 +0000)
git-svn-id: https://svn.dealii.org/trunk@6022 0785d39b-7218-0410-832d-ea1e28bc413d

deal.II/contrib/hsl/source/ma27.f [deleted file]
deal.II/contrib/hsl/source/ma47.f [deleted file]
deal.II/contrib/hsl/source/ma47dep.f [deleted file]

diff --git a/deal.II/contrib/hsl/source/ma27.f b/deal.II/contrib/hsl/source/ma27.f
deleted file mode 100644 (file)
index 19b0ab4..0000000
+++ /dev/null
@@ -1,2053 +0,0 @@
-C *******************************************************************
-* COPYRIGHT (c) 1993 AEA Technology
-
-C None of the comments in this Copyright notice between the lines
-C of asterisks shall be removed or altered in any way.
-
-C This Package is intended for compilation without modification,
-C so most of the embedded comments have been removed.
-
-C ALL USE IS SUBJECT TO LICENCE. For full details of an HSL ARCHIVE
-C Licence, see http://hsl.rl.ac.uk/archive/cou.html
-
-C Please note that for an HSL ARCHIVE Licence:
-
-C 1. The Package must not be copied for use by any other person.
-C    Supply of any part of the library by the Licensee to a third party
-C    shall be subject to prior written agreement between AEA
-C    Technology plc and the Licensee on suitable terms and conditions,
-C    which will include financial conditions.
-C 2. All information on the Package is provided to the Licensee on the
-C    understanding that the details thereof are confidential.
-C 3. All publications issued by the Licensee that include results obtained
-C    with the help of one or more of the Packages shall acknowledge the
-C    use of the Packages. The Licensee will notify the Numerical Analysis
-C    Group at Rutherford Appleton Laboratory of any such publication.
-C 4. The Packages may be modified by or on behalf of the Licensee
-C    for such use in research applications but at no time shall such
-C    Packages or modifications thereof become the property of the
-C    Licensee. The Licensee shall make available free of charge to the
-C    copyright holder for any purpose all information relating to
-C    any modification.
-C 5. Neither CCLRC nor AEA Technology plc shall be liable for any
-C    direct or consequential loss or damage whatsoever arising out of
-C    the use of Packages by the Licensee.
-C *******************************************************************
-
-*######DATE 13 Jan 1993
-C       Toolpack tool decs employed.
-C       MA27SD reference removed - replaced for the vax (9/12/93).
-C       MA27ED and MA27FD not used in MA27CD.
-C       SAVE statements added.
-C       DATA statements made PARAMETER.
-C 19/3/98 If there is an error (IFLAG<0), NSTEPS is set to zero and no
-C     monitor printing is produced on exit. Extra tests for NZ=0 added.
-C 16/4/98 Small alteration to format of monitor printing
-C 7/12/98 Real copy of NELIM used in OPS calculation.
-C 26/3/99 Special treatment of full and near-full rows added to MA27AD.
-C 29/3/99 Test on NSTEPS added to MA27BD.
-C 29/3/00 Test on absolute size of pivots added (MA27TD/PIVTOL).
-C 3/7/00  Bug associated with 26/3/99 changes corrected in MA27HD.
-
-      SUBROUTINE MA27AD(N,NZ,IRN,ICN,IW,LIW,IKEEP,IW1,NSTEPS,IFLAG)
-      INTEGER IFLAG,LIW,N,NSTEPS,NZ
-      INTEGER ICN(*),IKEEP(N,3),IRN(*),IW(LIW),IW1(N,2)
-      INTEGER I,IWFR,K,L1,L2,LLIW
-      EXTERNAL MA27GD,MA27HD,MA27JD,MA27KD,MA27LD,MA27MD,MA27SD
-      INTRINSIC MIN0
-      COMMON /MA27DD/U,LP,MP,LDIAG
-      COMMON /MA27ED/OPS,IERROR,NRLTOT,NIRTOT,NRLNEC,NIRNEC,NRLADU,
-     +       NIRADU,NRLBDU,NIRBDU,NCMPA,NCMPBR,NCMPBI,NTWO,NEIG
-      COMMON /MA27FD/IOVFLO,NEMIN,IFRLVL(20)
-      DOUBLE PRECISION OPS,U
-      INTEGER IERROR,IOVFLO,LDIAG,LP,MP,NCMPA,NCMPBI,NCMPBR,NEIG,NEMIN,
-     +        NIRADU,NIRBDU,NIRNEC,NIRTOT,NRLADU,NRLBDU,NRLNEC,NRLTOT,
-     +        NTWO
-      INTEGER IFRLVL
-      SAVE /MA27DD/,/MA27ED/,/MA27FD/
-      IF (LDIAG.LE.0 .OR. MP.LE.0) GO TO 40
-      WRITE (MP,FMT=10) N,NZ,LIW,IFLAG
-   10 FORMAT(/,/,' ENTERING MA27AD WITH      N     NZ      LIW  IFLAG',
-     +       /,21X,I7,I7,I9,I7)
-      NSTEPS = 0
-      K = MIN0(8,NZ)
-      IF (LDIAG.GT.1) K = NZ
-      IF (K.GT.0) WRITE (MP,FMT=20) (IRN(I),ICN(I),I=1,K)
-   20 FORMAT (17H MATRIX NON-ZEROS,/,4 (I9,I6),/,
-     +       (I9,I6,I9,I6,I9,I6,I9,I6))
-      K = MIN0(10,N)
-      IF (LDIAG.GT.1) K = N
-      IF (IFLAG.EQ.1 .AND. K.GT.0) WRITE (MP,FMT=30) (IKEEP(I,1),I=1,K)
-   30 FORMAT (12H IKEEP(.,1)=,10I6,/, (12X,10I6))
-   40 IF (N.LT.1 .OR. N.GT.IOVFLO) GO TO 70
-      IF (NZ.LT.0) GO TO 100
-      LLIW = LIW - 2*N
-      L1 = LLIW + 1
-      L2 = L1 + N
-      IF (IFLAG.EQ.1) GO TO 50
-      IF (LIW.LT.2*NZ+3*N+1) GO TO 130
-      IFLAG = 0
-      CALL MA27GD(N,NZ,IRN,ICN,IW,LLIW,IW1,IW1(1,2),IW(L1),IWFR,IFLAG)
-      CALL MA27HD(N,IW1,IW,LLIW,IWFR,IW(L1),IW(L2),IKEEP(1,2),
-     +            IKEEP(1,3),IKEEP)
-      GO TO 60
-   50 IF (LIW.LT.NZ+3*N+1) GO TO 120
-      CALL MA27JD(N,NZ,IRN,ICN,IKEEP,IW,LLIW,IW1,IW1(1,2),IW(L1),IWFR,
-     +            IFLAG)
-      CALL MA27KD(N,IW1,IW,LLIW,IWFR,IKEEP,IKEEP(1,2),IW(L1),IW(L2))
-   60 CALL MA27LD(N,IW1,IW(L1),IKEEP,IKEEP(1,2),IKEEP(1,3),IW(L2),
-     +            NSTEPS)
-      IF(NZ.GE.1) IW(1) = IRN(1) + 1
-      CALL MA27MD(N,NZ,IRN,ICN,IKEEP,IKEEP(1,3),IKEEP(1,2),IW(L2),
-     +            NSTEPS,IW1,IW1(1,2),IW)
-      GO TO 160
-   70 IFLAG = -1
-      IF (LP.GT.0) WRITE (LP,FMT=80) IFLAG
-   80 FORMAT (42H **** ERROR RETURN FROM MA27AD **** IFLAG=,I3)
-      IF (LP.GT.0) WRITE (LP,FMT=90) N
-   90 FORMAT (30H VALUE OF N OUT OF RANGE ... =,I10)
-      GO TO 160
-  100 IFLAG = -2
-      IF (LP.GT.0) WRITE (LP,FMT=80) IFLAG
-      IF (LP.GT.0) WRITE (LP,FMT=110) NZ
-  110 FORMAT (30H VALUE OF NZ OUT OF RANGE .. =,I10)
-      GO TO 160
-  120 IERROR = NZ + 3*N + 1
-      GO TO 140
-  130 IERROR = 2*NZ + 3*N + 1
-  140 IFLAG = -3
-      IF (LP.GT.0) WRITE (LP,FMT=80) IFLAG
-      IF (LP.GT.0) WRITE (LP,FMT=150) LIW,IERROR
-  150 FORMAT (38H LIW TOO SMALL, MUST BE INCREASED FROM,I10,3H TO,
-     +       9H AT LEAST,I10)
-  160 IF (LDIAG.LE.0 .OR. MP.LE.0 .OR. IFLAG.LT.0) GO TO 200
-      WRITE (MP,FMT=170) NSTEPS,IFLAG,OPS,IERROR,NRLTOT,NIRTOT,NRLNEC,
-     +  NIRNEC,NRLADU,NIRADU,NCMPA
-  170 FORMAT (/,53H LEAVING MA27AD WITH NSTEPS  IFLAG    OPS IERROR NRLT
-     +       ,2HOT,7H NIRTOT,/,20X,2I7,F7.0,3I7,/,20X,
-     +       20H NRLNEC NIRNEC NRLAD,15HU NIRADU  NCMPA,/,20X,6I7)
-      K = MIN0(9,N)
-      IF (LDIAG.GT.1) K = N
-      IF (K.GT.0) WRITE (MP,FMT=30) (IKEEP(I,1),I=1,K)
-      K = MIN0(K,NSTEPS)
-      IF (K.GT.0) WRITE (MP,FMT=180) (IKEEP(I,2),I=1,K)
-  180 FORMAT (12H IKEEP(.,2)=,10I6,/, (12X,10I6))
-      IF (K.GT.0) WRITE (MP,FMT=190) (IKEEP(I,3),I=1,K)
-  190 FORMAT (12H IKEEP(.,3)=,10I6,/, (12X,10I6))
-  200 RETURN
-      END
-      SUBROUTINE MA27BD(N,NZ,IRN,ICN,A,LA,IW,LIW,IKEEP,NSTEPS,MAXFRT,
-     +                  IW1,IFLAG)
-      INTEGER IFLAG,LA,LIW,MAXFRT,N,NSTEPS,NZ
-      DOUBLE PRECISION A(LA)
-      INTEGER ICN(*),IKEEP(N,3),IRN(*),IW(LIW),IW1(N)
-      INTEGER I,IAPOS,IBLK,IPOS,IROWS,J1,J2,JJ,K,KBLK,KZ,LEN,NCOLS,
-     +        NROWS,NZ1
-      EXTERNAL MA27ND,MA27OD
-      INTRINSIC IABS,MIN0
-      COMMON /MA27DD/U,LP,MP,LDIAG
-      COMMON /MA27ED/OPS,IERROR,NRLTOT,NIRTOT,NRLNEC,NIRNEC,NRLADU,
-     +       NIRADU,NRLBDU,NIRBDU,NCMPA,NCMPBR,NCMPBI,NTWO,NEIG
-      COMMON /MA27FD/IOVFLO,NEMIN,IFRLVL(20)
-      DOUBLE PRECISION OPS,U
-      INTEGER IERROR,IOVFLO,LDIAG,LP,MP,NCMPA,NCMPBI,NCMPBR,NEIG,NEMIN,
-     +        NIRADU,NIRBDU,NIRNEC,NIRTOT,NRLADU,NRLBDU,NRLNEC,NRLTOT,
-     +        NTWO
-      INTEGER IFRLVL
-      SAVE /MA27DD/,/MA27ED/,/MA27FD/
-      IF (LDIAG.LE.0 .OR. MP.LE.0) GO TO 60
-      WRITE (MP,FMT=10) N,NZ,LA,LIW,NSTEPS,U
-   10 FORMAT (/,/,
-     + ' ENTERING MA27BD WITH      N     NZ       LA      LIW',
-     +       ' NSTEPS      U',/,21X,I7,I7,I9,I9,I7,1PE10.2)
-      KZ = MIN0(6,NZ)
-      IF (LDIAG.GT.1) KZ = NZ
-      IF (NZ.GT.0) WRITE (MP,FMT=20) (A(K),IRN(K),ICN(K),K=1,KZ)
-   20 FORMAT (17H MATRIX NON-ZEROS,/,1X,2 (1P,D16.3,2I6),/,
-     +       (1X,1P,D16.3,2I6,1P,D16.3,2I6))
-      K = MIN0(9,N)
-      IF (LDIAG.GT.1) K = N
-      IF (K.GT.0) WRITE (MP,FMT=30) (IKEEP(I,1),I=1,K)
-   30 FORMAT (12H IKEEP(.,1)=,10I6,/, (12X,10I6))
-      K = MIN0(K,NSTEPS)
-      IF (K.GT.0) WRITE (MP,FMT=40) (IKEEP(I,2),I=1,K)
-   40 FORMAT (12H IKEEP(.,2)=,10I6,/, (12X,10I6))
-      IF (K.GT.0) WRITE (MP,FMT=50) (IKEEP(I,3),I=1,K)
-   50 FORMAT (12H IKEEP(.,3)=,10I6,/, (12X,10I6))
-   60 IF (N.LT.1 .OR. N.GT.IOVFLO) GO TO 70
-      IF (NZ.LT.0) GO TO 100
-      IF (LIW.LT.NZ) GO TO 120
-      IF (LA.LT.NZ+N) GO TO 150
-      IF (NSTEPS.LT.1 .OR. NSTEPS.GT.N) GO TO 175
-      CALL MA27ND(N,NZ,NZ1,A,LA,IRN,ICN,IW,LIW,IKEEP,IW1,IFLAG)
-      IF (IFLAG.EQ.-3) GO TO 130
-      IF (IFLAG.EQ.-4) GO TO 160
-      CALL MA27OD(N,NZ1,A,LA,IW,LIW,IKEEP,IKEEP(1,3),NSTEPS,MAXFRT,
-     +            IKEEP(1,2),IW1,IFLAG)
-      IF (IFLAG.EQ.-3) GO TO 130
-      IF (IFLAG.EQ.-4) GO TO 160
-      IF (IFLAG.EQ.-5) GO TO 180
-      IF (IFLAG.EQ.-6) GO TO 200
-      IF (IFLAG.EQ.3 .AND. MP.GT.0) WRITE (MP,FMT=65) IFLAG,IERROR
-   65 FORMAT (52H *** WARNING MESSAGE FROM SUBROUTINE MA27BD *** IFLA,
-     +       3HG =,I2,/,5X,25HMATRIX IS SINGULAR. RANK=,I5)
-      GO TO 220
-   70 IFLAG = -1
-      IF (LP.GT.0) WRITE (LP,FMT=80) IFLAG
-   80 FORMAT (42H **** ERROR RETURN FROM MA27BD **** IFLAG=,I3)
-      IF (LP.GT.0) WRITE (LP,FMT=90) N
-   90 FORMAT (30H VALUE OF N OUT OF RANGE ... =,I10)
-      GO TO 220
-  100 IFLAG = -2
-      IF (LP.GT.0) WRITE (LP,FMT=80) IFLAG
-      IF (LP.GT.0) WRITE (LP,FMT=110) NZ
-  110 FORMAT (30H VALUE OF NZ OUT OF RANGE .. =,I10)
-      GO TO 220
-  120 IFLAG = -3
-      IERROR = NZ
-  130 IF (LP.GT.0) WRITE (LP,FMT=80) IFLAG
-      IF (LP.GT.0) WRITE (LP,FMT=140) LIW,IERROR
-  140 FORMAT (38H LIW TOO SMALL, MUST BE INCREASED FROM,I10,3H TO,
-     +       9H AT LEAST,I10)
-      GO TO 220
-  150 IFLAG = -4
-      IERROR = NZ + N
-  160 IF (LP.GT.0) WRITE (LP,FMT=80) IFLAG
-      IF (LP.GT.0) WRITE (LP,FMT=170) LA,IERROR
-  170 FORMAT (38H LA TOO SMALL, MUST BE INCREASED FROM ,I10,3H TO,
-     +       9H AT LEAST,I10)
-      GO TO 220
-  175 IFLAG = -7
-      IF (LP.GT.0) WRITE (LP,FMT=80) IFLAG
-      IF (LP.GT.0) WRITE (LP,FMT='(A)') ' NSTEPS is out of range'
-      GO TO 220
-  180 IF (LP.GT.0) WRITE (LP,FMT=80) IFLAG
-      IF (LP.GT.0) WRITE (LP,FMT=190) IERROR
-  190 FORMAT (20H ZERO PIVOT AT STAGE,I10,24H WHEN INPUT MATRIX DECLA,
-     +       12HRED DEFINITE)
-      GO TO 220
-  200 IF (LP.GT.0) WRITE (LP,FMT=80) IFLAG
-      IF (LP.GT.0) WRITE (LP,FMT=210)
-  210 FORMAT (36H CHANGE IN SIGN OF PIVOT ENCOUNTERED,13H WHEN FACTORI,
-     +       28HNG ALLEGEDLY DEFINITE MATRIX)
-  220 IF (LDIAG.LE.0 .OR. MP.LE.0 .OR. IFLAG.LT.0) GO TO 310
-      WRITE (MP,FMT=230) MAXFRT,IFLAG,NRLBDU,NIRBDU,NCMPBR,NCMPBI,NTWO,
-     +  IERROR
-  230 FORMAT (/,20H LEAVING MA27BD WITH,/,10X,
-     +       36H  MAXFRT  IFLAG NRLBDU NIRBDU NCMPBR,
-     +       21H NCMPBI   NTWO IERROR,/,11X,8I7)
-      IF (IFLAG.LT.0) GO TO 310
-      KBLK = IABS(IW(1)+0)
-      IF (KBLK.EQ.0) GO TO 310
-      IF (LDIAG.EQ.1) KBLK = 1
-      IPOS = 2
-      IAPOS = 1
-      DO 300 IBLK = 1,KBLK
-        NCOLS = IW(IPOS)
-        NROWS = IW(IPOS+1)
-        J1 = IPOS + 2
-        IF (NCOLS.GT.0) GO TO 240
-        NCOLS = -NCOLS
-        NROWS = 1
-        J1 = J1 - 1
-  240   WRITE (MP,FMT=250) IBLK,NROWS,NCOLS
-  250   FORMAT (14H BLOCK PIVOT =,I8,8H NROWS =,I8,8H NCOLS =,I8)
-        J2 = J1 + NCOLS - 1
-        IPOS = J2 + 1
-        WRITE (MP,FMT=260) (IW(JJ),JJ=J1,J2)
-  260   FORMAT (17H COLUMN INDICES =,10I6,/, (17X,10I6))
-        WRITE (MP,FMT=270)
-  270   FORMAT (46H REAL ENTRIES .. EACH ROW STARTS ON A NEW LINE)
-        LEN = NCOLS
-        DO 290 IROWS = 1,NROWS
-          J1 = IAPOS
-          J2 = IAPOS + LEN - 1
-          WRITE (MP,FMT=280) (A(JJ),JJ=J1,J2)
-  280     FORMAT (1P,5D13.3)
-          LEN = LEN - 1
-          IAPOS = J2 + 1
-  290   CONTINUE
-  300 CONTINUE
-  310 RETURN
-      END
-      SUBROUTINE MA27CD(N,A,LA,IW,LIW,W,MAXFRT,RHS,IW1,NSTEPS)
-      INTEGER LA,LIW,MAXFRT,N,NSTEPS
-      DOUBLE PRECISION A(LA),RHS(N),W(MAXFRT)
-      INTEGER IW(LIW),IW1(NSTEPS)
-      INTEGER I,IAPOS,IBLK,IPOS,IROWS,J1,J2,JJ,K,KBLK,LATOP,LEN,NBLK,
-     +        NCOLS,NROWS
-      EXTERNAL MA27QD,MA27RD
-      INTRINSIC IABS,MIN0
-      COMMON /MA27DD/U,LP,MP,LDIAG
-      DOUBLE PRECISION U
-      INTEGER LDIAG,LP,MP
-      SAVE /MA27DD/
-      IF (LDIAG.LE.0 .OR. MP.LE.0) GO TO 110
-      WRITE (MP,FMT=10) N,LA,LIW,MAXFRT,NSTEPS
-   10 FORMAT (/,/,49H ENTERING MA27CD WITH      N     LA    LIW MAXFRT,
-     +       8H  NSTEPS,/,21X,5I7)
-      KBLK = IABS(IW(1)+0)
-      IF (KBLK.EQ.0) GO TO 90
-      IF (LDIAG.EQ.1) KBLK = 1
-      IPOS = 2
-      IAPOS = 1
-      DO 80 IBLK = 1,KBLK
-        NCOLS = IW(IPOS)
-        NROWS = IW(IPOS+1)
-        J1 = IPOS + 2
-        IF (NCOLS.GT.0) GO TO 20
-        NCOLS = -NCOLS
-        NROWS = 1
-        J1 = J1 - 1
-   20   WRITE (MP,FMT=30) IBLK,NROWS,NCOLS
-   30   FORMAT (14H BLOCK PIVOT =,I8,8H NROWS =,I8,8H NCOLS =,I8)
-        J2 = J1 + NCOLS - 1
-        IPOS = J2 + 1
-        WRITE (MP,FMT=40) (IW(JJ),JJ=J1,J2)
-   40   FORMAT (17H COLUMN INDICES =,10I6,/, (17X,10I6))
-        WRITE (MP,FMT=50)
-   50   FORMAT (46H REAL ENTRIES .. EACH ROW STARTS ON A NEW LINE)
-        LEN = NCOLS
-        DO 70 IROWS = 1,NROWS
-          J1 = IAPOS
-          J2 = IAPOS + LEN - 1
-          WRITE (MP,FMT=60) (A(JJ),JJ=J1,J2)
-   60     FORMAT (1P,5D13.3)
-          LEN = LEN - 1
-          IAPOS = J2 + 1
-   70   CONTINUE
-   80 CONTINUE
-   90 K = MIN0(10,N)
-      IF (LDIAG.GT.1) K = N
-      IF (N.GT.0) WRITE (MP,FMT=100) (RHS(I),I=1,K)
-  100 FORMAT (4H RHS,1P,5D13.3,/, (4X,1P,5D13.3))
-  110 IF (IW(1).LT.0) GO TO 130
-      NBLK = IW(1)
-      IF (NBLK.GT.0) GO TO 140
-      DO 120 I = 1,N
-        RHS(I) = 0.0D0
-  120 CONTINUE
-      GO TO 150
-  130 NBLK = -IW(1)
-  140 CALL MA27QD(N,A,LA,IW(2),LIW-1,W,MAXFRT,RHS,IW1,NBLK,LATOP)
-      CALL MA27RD(N,A,LA,IW(2),LIW-1,W,MAXFRT,RHS,IW1,NBLK,LATOP)
-  150 IF (LDIAG.LE.0 .OR. MP.LE.0) GO TO 170
-      WRITE (MP,FMT=160)
-  160 FORMAT (/,/,20H LEAVING MA27CD WITH)
-      IF (N.GT.0) WRITE (MP,FMT=100) (RHS(I),I=1,K)
-  170 RETURN
-      END
-      BLOCK DATA MA27SD
-      COMMON /MA27DD/U,LP,MP,LDIAG
-      COMMON /MA27FD/IOVFLO,NEMIN,IFRLVL(20)
-      DOUBLE PRECISION U
-      INTEGER IOVFLO,LDIAG,LP,MP,NEMIN
-      INTEGER IFRLVL
-      COMMON /MA27TD/FRATIO,PIVTOL
-      DOUBLE PRECISION FRATIO,PIVTOL
-      SAVE /MA27DD/,/MA27FD/,/MA27TD/
-      DATA U/0.1D0/,LP/6/,MP/6/,LDIAG/0/
-      DATA FRATIO/1.0D0/, PIVTOL/0.0D0/
-      DATA IOVFLO/2139062143/,NEMIN/1/,
-     +     IFRLVL(1),IFRLVL(2),IFRLVL(3),IFRLVL(4),IFRLVL(5),IFRLVL(6),
-     +     IFRLVL(7),IFRLVL(8),IFRLVL(9),IFRLVL(10),IFRLVL(11),
-     +     IFRLVL(12),IFRLVL(13),IFRLVL(14),IFRLVL(15),IFRLVL(16),
-     +     IFRLVL(17),IFRLVL(18),IFRLVL(19),IFRLVL(20)/32639,32639,
-     +     32639,32639,14,9,8,8,9,10,32639,32639,32639,32689,24,11,9,8,
-     +     9,10/
-      END
-      SUBROUTINE MA27GD(N,NZ,IRN,ICN,IW,LW,IPE,IQ,FLAG,IWFR,IFLAG)
-      INTEGER IFLAG,IWFR,LW,N,NZ
-      INTEGER FLAG(N),ICN(*),IPE(N),IQ(N),IRN(*),IW(LW)
-      INTEGER I,ID,J,JN,K,K1,K2,L,LAST,LR,N1,NDUP
-      COMMON /MA27DD/U,LP,MP,LDIAG
-      COMMON /MA27ED/OPS,IERROR,NRLTOT,NIRTOT,NRLNEC,NIRNEC,NRLADU,
-     +       NIRADU,NRLBDU,NIRBDU,NCMPA,NCMPBR,NCMPBI,NTWO,NEIG
-      DOUBLE PRECISION OPS,U
-      INTEGER IERROR,LDIAG,LP,MP,NCMPA,NCMPBI,NCMPBR,NEIG,NIRADU,NIRBDU,
-     +        NIRNEC,NIRTOT,NRLADU,NRLBDU,NRLNEC,NRLTOT,NTWO
-      SAVE /MA27DD/,/MA27ED/
-      IERROR = 0
-      DO 10 I = 1,N
-        IPE(I) = 0
-   10 CONTINUE
-      LR = NZ
-      IF (NZ.EQ.0) GO TO 120
-      DO 110 K = 1,NZ
-        I = IRN(K)
-        J = ICN(K)
-        IF (I-J) 20,40,30
-   20   IF (I.GE.1 .AND. J.LE.N) GO TO 90
-        GO TO 50
-   30   IF (J.GE.1 .AND. I.LE.N) GO TO 90
-        GO TO 50
-   40   IF (I.GE.1 .AND. I.LE.N) GO TO 80
-   50   IERROR = IERROR + 1
-        IFLAG = 1
-        IF (IERROR.LE.1 .AND. MP.GT.0) WRITE (MP,FMT=60) IFLAG
-   60   FORMAT (52H *** WARNING MESSAGE FROM SUBROUTINE MA27AD *** IFLA,
-     +         3HG =,I2)
-        IF (IERROR.LE.10 .AND. MP.GT.0) WRITE (MP,FMT=70) K,I,J
-   70   FORMAT (I6,19HTH NON-ZERO (IN ROW,I6,11H AND COLUMN,I6,
-     +         9H) IGNORED)
-   80   I = 0
-        J = 0
-        GO TO 100
-   90   IPE(I) = IPE(I) + 1
-        IPE(J) = IPE(J) + 1
-  100   IW(K) = J
-        LR = LR + 1
-        IW(LR) = I
-  110 CONTINUE
-  120 IQ(1) = 1
-      N1 = N - 1
-      IF (N1.LE.0) GO TO 140
-      DO 130 I = 1,N1
-        FLAG(I) = 0
-        IF (IPE(I).EQ.0) IPE(I) = -1
-        IQ(I+1) = IPE(I) + IQ(I) + 1
-        IPE(I) = IQ(I)
-  130 CONTINUE
-  140 LAST = IPE(N) + IQ(N)
-      FLAG(N) = 0
-      IF (LR.GE.LAST) GO TO 160
-      K1 = LR + 1
-      DO 150 K = K1,LAST
-        IW(K) = 0
-  150 CONTINUE
-  160 IPE(N) = IQ(N)
-      IWFR = LAST + 1
-      IF (NZ.EQ.0) GO TO 230
-      DO 220 K = 1,NZ
-        J = IW(K)
-        IF (J.LE.0) GO TO 220
-        L = K
-        IW(K) = 0
-        DO 210 ID = 1,NZ
-          IF (L.GT.NZ) GO TO 170
-          L = L + NZ
-          GO TO 180
-  170     L = L - NZ
-  180     I = IW(L)
-          IW(L) = 0
-          IF (I.LT.J) GO TO 190
-          L = IQ(J) + 1
-          IQ(J) = L
-          JN = IW(L)
-          IW(L) = -I
-          GO TO 200
-  190     L = IQ(I) + 1
-          IQ(I) = L
-          JN = IW(L)
-          IW(L) = -J
-  200     J = JN
-          IF (J.LE.0) GO TO 220
-  210   CONTINUE
-  220 CONTINUE
-  230 NDUP = 0
-      DO 280 I = 1,N
-        K1 = IPE(I) + 1
-        K2 = IQ(I)
-        IF (K1.LE.K2) GO TO 240
-        IPE(I) = 0
-        IQ(I) = 0
-        GO TO 280
-  240   DO 260 K = K1,K2
-          J = -IW(K)
-          IF (J.LE.0) GO TO 270
-          L = IQ(J) + 1
-          IQ(J) = L
-          IW(L) = I
-          IW(K) = J
-          IF (FLAG(J).NE.I) GO TO 250
-          NDUP = NDUP + 1
-          IW(L) = 0
-          IW(K) = 0
-  250     FLAG(J) = I
-  260   CONTINUE
-  270   IQ(I) = IQ(I) - IPE(I)
-        IF (NDUP.EQ.0) IW(K1-1) = IQ(I)
-  280 CONTINUE
-      IF (NDUP.EQ.0) GO TO 310
-      IWFR = 1
-      DO 300 I = 1,N
-        K1 = IPE(I) + 1
-        IF (K1.EQ.1) GO TO 300
-        K2 = IQ(I) + IPE(I)
-        L = IWFR
-        IPE(I) = IWFR
-        IWFR = IWFR + 1
-        DO 290 K = K1,K2
-          IF (IW(K).EQ.0) GO TO 290
-          IW(IWFR) = IW(K)
-          IWFR = IWFR + 1
-  290   CONTINUE
-        IW(L) = IWFR - L - 1
-  300 CONTINUE
-  310 RETURN
-      END
-      SUBROUTINE MA27HD(N,IPE,IW,LW,IWFR,NV,NXT,LST,IPD,FLAG)
-      INTEGER IWFR,LW,N
-      INTEGER FLAG(N),IPD(N),IPE(N),IW(LW),LST(N),NV(N),NXT(N)
-      INTEGER I,ID,IDL,IDN,IE,IP,IS,JP,JP1,JP2,JS,K,K1,K2,KE,KP,KP0,KP1,
-     +        KP2,KS,L,LEN,LIMIT,LN,LS,LWFR,MD,ME,ML,MS,NEL,NFLG,NP,
-     +        NP0,NS,NVPIV,NVROOT,ROOT
-      EXTERNAL MA27ID
-      INTRINSIC IABS,MIN0
-      COMMON /MA27ED/OPS,IERROR,NRLTOT,NIRTOT,NRLNEC,NIRNEC,NRLADU,
-     +       NIRADU,NRLBDU,NIRBDU,NCMPA,NCMPBR,NCMPBI,NTWO,NEIG
-      COMMON /MA27FD/IOVFLO,NEMIN,IFRLVL(20)
-      DOUBLE PRECISION OPS
-      INTEGER IERROR,IOVFLO,NCMPA,NCMPBI,NCMPBR,NEIG,NEMIN,NIRADU,
-     +        NIRBDU,NIRNEC,NIRTOT,NRLADU,NRLBDU,NRLNEC,NRLTOT,NTWO
-      INTEGER IFRLVL
-      COMMON /MA27TD/FRATIO,PIVTOL
-      DOUBLE PRECISION FRATIO,PIVTOL
-      SAVE /MA27ED/,/MA27FD/,/MA27TD/
-      DO 10 I = 1,N
-        IPD(I) = 0
-        NV(I) = 1
-        FLAG(I) = IOVFLO
-   10 CONTINUE
-      MD = 1
-      NCMPA = 0
-      NFLG = IOVFLO
-      NEL = 0
-      ROOT = N+1
-      NVROOT = 0
-      DO 30 IS = 1,N
-        K = IPE(IS)
-        IF (K.LE.0) GO TO 20
-        ID = IW(K) + 1
-        NS = IPD(ID)
-        IF (NS.GT.0) LST(NS) = IS
-        NXT(IS) = NS
-        IPD(ID) = IS
-        LST(IS) = -ID
-        GO TO 30
-   20   NEL = NEL + 1
-        FLAG(IS) = -1
-        NXT(IS) = 0
-        LST(IS) = 0
-   30 CONTINUE
-      DO 340 ML = 1,N
-        IF (NEL+NVROOT+1.GE.N) GO TO 350
-        DO 40 ID = MD,N
-          MS = IPD(ID)
-          IF (MS.GT.0) GO TO 50
-   40   CONTINUE
-   50   MD = ID
-        NVPIV = NV(MS)
-        NS = NXT(MS)
-        NXT(MS) = 0
-        LST(MS) = 0
-        IF (NS.GT.0) LST(NS) = -ID
-        IPD(ID) = NS
-        ME = MS
-        NEL = NEL + NVPIV
-        IDN = 0
-        KP = IPE(ME)
-        FLAG(MS) = -1
-        IP = IWFR
-        LEN = IW(KP)
-        DO 140 KP1 = 1,LEN
-          KP = KP + 1
-          KE = IW(KP)
-          IF (FLAG(KE).LE.-2) GO TO 60
-          IF (FLAG(KE).LE.0) THEN
-             IF (IPE(KE).NE.-ROOT) GO TO 140
-             KE = ROOT
-             IF (FLAG(KE).LE.0) GO TO 140
-          END IF
-          JP = KP - 1
-          LN = LEN - KP1 + 1
-          IE = MS
-          GO TO 70
-   60     IE = KE
-          JP = IPE(IE)
-          LN = IW(JP)
-   70     DO 130 JP1 = 1,LN
-            JP = JP + 1
-            IS = IW(JP)
-            IF (FLAG(IS).LE.0) THEN
-               IF (IPE(IS).EQ.-ROOT) THEN
-                  IS = ROOT
-                  IW(JP) = ROOT
-                  IF (FLAG(IS).LE.0) GO TO 130
-               ELSE
-                  GO TO 130
-               END IF
-            END IF
-            FLAG(IS) = 0
-            IF (IWFR.LT.LW) GO TO 100
-            IPE(MS) = KP
-            IW(KP) = LEN - KP1
-            IPE(IE) = JP
-            IW(JP) = LN - JP1
-            CALL MA27ID(N,IPE,IW,IP-1,LWFR)
-            JP2 = IWFR - 1
-            IWFR = LWFR
-            IF (IP.GT.JP2) GO TO 90
-            DO 80 JP = IP,JP2
-              IW(IWFR) = IW(JP)
-              IWFR = IWFR + 1
-   80       CONTINUE
-   90       IP = LWFR
-            JP = IPE(IE)
-            KP = IPE(ME)
-  100       IW(IWFR) = IS
-            IDN = IDN + NV(IS)
-            IWFR = IWFR + 1
-            LS = LST(IS)
-            LST(IS) = 0
-            NS = NXT(IS)
-            NXT(IS) = 0
-            IF (NS.GT.0) LST(NS) = LS
-            IF (LS) 110,130,120
-  110       LS = -LS
-            IPD(LS) = NS
-            GO TO 130
-  120       NXT(LS) = NS
-  130     CONTINUE
-          IF (IE.EQ.MS) GO TO 150
-          IPE(IE) = -ME
-          FLAG(IE) = -1
-  140   CONTINUE
-  150   NV(MS) = IDN + NVPIV
-        IF (IWFR.EQ.IP) GO TO 330
-        K1 = IP
-        K2 = IWFR - 1
-        LIMIT = NINT(FRATIO*(N-NEL))
-        DO 310 K = K1,K2
-          IS = IW(K)
-          IF (IS.EQ.ROOT) GO TO 310
-          IF (NFLG.GT.2) GO TO 170
-          DO 160 I = 1,N
-            IF (FLAG(I).GT.0) FLAG(I) = IOVFLO
-            IF (FLAG(I).LE.-2) FLAG(I) = -IOVFLO
-  160     CONTINUE
-          NFLG = IOVFLO
-  170     NFLG = NFLG - 1
-          ID = IDN
-          KP1 = IPE(IS) + 1
-          NP = KP1
-          KP2 = IW(KP1-1) + KP1 - 1
-          DO 220 KP = KP1,KP2
-            KE = IW(KP)
-          IF (FLAG(KE).EQ.-1) THEN
-             IF (IPE(KE).NE.-ROOT) GO TO 220
-             KE = ROOT
-             IW(KP) = ROOT
-             IF (FLAG(KE).EQ.-1) GO TO 220
-          END IF
-          IF (FLAG(KE).GE.0) GO TO 230
-            JP1 = IPE(KE) + 1
-            JP2 = IW(JP1-1) + JP1 - 1
-            IDL = ID
-            DO 190 JP = JP1,JP2
-              JS = IW(JP)
-              IF (FLAG(JS).LE.NFLG) GO TO 190
-              ID = ID + NV(JS)
-              FLAG(JS) = NFLG
-  190       CONTINUE
-            IF (ID.GT.IDL) GO TO 210
-            DO 200 JP = JP1,JP2
-              JS = IW(JP)
-              IF (FLAG(JS).NE.0) GO TO 210
-  200       CONTINUE
-            IPE(KE) = -ME
-            FLAG(KE) = -1
-            GO TO 220
-  210       IW(NP) = KE
-            FLAG(KE) = -NFLG
-            NP = NP + 1
-  220     CONTINUE
-          NP0 = NP
-          GO TO 250
-  230     KP0 = KP
-          NP0 = NP
-          DO 240 KP = KP0,KP2
-            KS = IW(KP)
-            IF (FLAG(KS).LE.NFLG) THEN
-               IF (IPE(KS).EQ.-ROOT) THEN
-                  KS = ROOT
-                  IW(KP) = ROOT
-                  IF (FLAG(KS).LE.NFLG) GO TO 240
-               ELSE
-                  GO TO 240
-               END IF
-            END IF
-            ID = ID + NV(KS)
-            FLAG(KS) = NFLG
-            IW(NP) = KS
-            NP = NP + 1
-  240     CONTINUE
-  250     IF (ID.GE.LIMIT) GO TO 295
-          IW(NP) = IW(NP0)
-          IW(NP0) = IW(KP1)
-          IW(KP1) = ME
-          IW(KP1-1) = NP - KP1 + 1
-          JS = IPD(ID)
-          DO 280 L = 1,N
-            IF (JS.LE.0) GO TO 300
-            KP1 = IPE(JS) + 1
-            IF (IW(KP1).NE.ME) GO TO 300
-            KP2 = KP1 - 1 + IW(KP1-1)
-            DO 260 KP = KP1,KP2
-              IE = IW(KP)
-              IF (IABS(FLAG(IE)+0).GT.NFLG) GO TO 270
-  260       CONTINUE
-            GO TO 290
-  270       JS = NXT(JS)
-  280     CONTINUE
-  290     IPE(JS) = -IS
-          NV(IS) = NV(IS) + NV(JS)
-          NV(JS) = 0
-          FLAG(JS) = -1
-          NS = NXT(JS)
-          LS = LST(JS)
-          IF (NS.GT.0) LST(NS) = IS
-          IF (LS.GT.0) NXT(LS) = IS
-          LST(IS) = LS
-          NXT(IS) = NS
-          LST(JS) = 0
-          NXT(JS) = 0
-          IF (IPD(ID).EQ.JS) IPD(ID) = IS
-          GO TO 310
-  295     IF (NVROOT.EQ.0) THEN
-            ROOT = IS
-            IPE(IS) = 0
-          ELSE
-            IW(K) = ROOT
-            IPE(IS) = -ROOT
-            NV(ROOT) = NV(ROOT) + NV(IS)
-            NV(IS) = 0
-            FLAG(IS) = -1
-          END IF
-          NVROOT = NV(ROOT)
-          GO TO 310
-  300     NS = IPD(ID)
-          IF (NS.GT.0) LST(NS) = IS
-          NXT(IS) = NS
-          IPD(ID) = IS
-          LST(IS) = -ID
-          MD = MIN0(MD,ID)
-  310   CONTINUE
-        DO 320 K = K1,K2
-          IS = IW(K)
-          IF (NV(IS).EQ.0) GO TO 320
-          FLAG(IS) = NFLG
-          IW(IP) = IS
-          IP = IP + 1
-  320   CONTINUE
-        IWFR = K1
-        FLAG(ME) = -NFLG
-        IW(IP) = IW(K1)
-        IW(K1) = IP - K1
-        IPE(ME) = K1
-        IWFR = IP + 1
-        GO TO 335
-  330   IPE(ME) = 0
-  335   CONTINUE
-  340 CONTINUE
-  350 DO 360 IS = 1,N
-        IF(NXT(IS).NE.0 .OR. LST(IS).NE.0) THEN
-          IF (NVROOT.EQ.0) THEN
-            ROOT = IS
-            IPE(IS) = 0
-          ELSE
-            IPE(IS) = -ROOT
-          END IF
-          NVROOT = NVROOT + NV(IS)
-          NV(IS) = 0
-         END IF
-  360 CONTINUE
-      DO 370 IE = 1,N
-        IF (IPE(IE).GT.0) IPE(IE) = -ROOT
-  370 CONTINUE
-      IF(NVROOT.GT.0)NV(ROOT)=NVROOT
-      END
-      SUBROUTINE MA27ID(N,IPE,IW,LW,IWFR)
-      INTEGER IWFR,LW,N
-      INTEGER IPE(N),IW(LW)
-      INTEGER I,IR,K,K1,K2,LWFR
-      COMMON /MA27ED/OPS,IERROR,NRLTOT,NIRTOT,NRLNEC,NIRNEC,NRLADU,
-     +       NIRADU,NRLBDU,NIRBDU,NCMPA,NCMPBR,NCMPBI,NTWO,NEIG
-      DOUBLE PRECISION OPS
-      INTEGER IERROR,NCMPA,NCMPBI,NCMPBR,NEIG,NIRADU,NIRBDU,NIRNEC,
-     +        NIRTOT,NRLADU,NRLBDU,NRLNEC,NRLTOT,NTWO
-      SAVE /MA27ED/
-      NCMPA = NCMPA + 1
-      DO 10 I = 1,N
-        K1 = IPE(I)
-        IF (K1.LE.0) GO TO 10
-        IPE(I) = IW(K1)
-        IW(K1) = -I
-   10 CONTINUE
-      IWFR = 1
-      LWFR = IWFR
-      DO 60 IR = 1,N
-        IF (LWFR.GT.LW) GO TO 70
-        DO 20 K = LWFR,LW
-          IF (IW(K).LT.0) GO TO 30
-   20   CONTINUE
-        GO TO 70
-   30   I = -IW(K)
-        IW(IWFR) = IPE(I)
-        IPE(I) = IWFR
-        K1 = K + 1
-        K2 = K + IW(IWFR)
-        IWFR = IWFR + 1
-        IF (K1.GT.K2) GO TO 50
-        DO 40 K = K1,K2
-          IW(IWFR) = IW(K)
-          IWFR = IWFR + 1
-   40   CONTINUE
-   50   LWFR = K2 + 1
-   60 CONTINUE
-   70 RETURN
-      END
-      SUBROUTINE MA27JD(N,NZ,IRN,ICN,PERM,IW,LW,IPE,IQ,FLAG,IWFR,IFLAG)
-      INTEGER IFLAG,IWFR,LW,N,NZ
-      INTEGER FLAG(N),ICN(*),IPE(N),IQ(N),IRN(*),IW(LW),PERM(N)
-      INTEGER I,ID,IN,J,JDUMMY,K,K1,K2,L,LBIG,LEN
-      INTRINSIC MAX0
-      COMMON /MA27DD/U,LP,MP,LDIAG
-      COMMON /MA27ED/OPS,IERROR,NRLTOT,NIRTOT,NRLNEC,NIRNEC,NRLADU,
-     +       NIRADU,NRLBDU,NIRBDU,NCMPA,NCMPBR,NCMPBI,NTWO,NEIG
-      COMMON /MA27FD/IOVFLO,NEMIN,IFRLVL(20)
-      DOUBLE PRECISION OPS,U
-      INTEGER IERROR,IOVFLO,LDIAG,LP,MP,NCMPA,NCMPBI,NCMPBR,NEIG,NEMIN,
-     +        NIRADU,NIRBDU,NIRNEC,NIRTOT,NRLADU,NRLBDU,NRLNEC,NRLTOT,
-     +        NTWO
-      INTEGER IFRLVL
-      SAVE /MA27DD/,/MA27ED/,/MA27FD/
-      IFLAG = 0
-      IERROR = 0
-      DO 10 I = 1,N
-        IQ(I) = 0
-   10 CONTINUE
-      IF (NZ.EQ.0) GO TO 110
-      DO 100 K = 1,NZ
-        I = IRN(K)
-        J = ICN(K)
-        IW(K) = -I
-        IF (I-J) 20,40,30
-   20   IF (I.GE.1 .AND. J.LE.N) GO TO 80
-        GO TO 50
-   30   IF (J.GE.1 .AND. I.LE.N) GO TO 80
-        GO TO 50
-   40   IW(K) = 0
-        IF (I.GE.1 .AND. I.LE.N) GO TO 100
-   50   IERROR = IERROR + 1
-        IFLAG = 1
-        IW(K) = 0
-        IF (IERROR.LE.1 .AND. MP.GT.0) WRITE (MP,FMT=60) IFLAG
-   60   FORMAT (52H *** WARNING MESSAGE FROM SUBROUTINE MA27AD *** IFLA,
-     +         3HG =,I2)
-        IF (IERROR.LE.10 .AND. MP.GT.0) WRITE (MP,FMT=70) K,I,J
-   70   FORMAT (I6,19HTH NON-ZERO (IN ROW,I6,11H AND COLUMN,I6,
-     +         9H) IGNORED)
-        GO TO 100
-   80   IF (PERM(J).GT.PERM(I)) GO TO 90
-        IQ(J) = IQ(J) + 1
-        GO TO 100
-   90   IQ(I) = IQ(I) + 1
-  100 CONTINUE
-  110 IWFR = 1
-      LBIG = 0
-      DO 120 I = 1,N
-        L = IQ(I)
-        LBIG = MAX0(L,LBIG)
-        IWFR = IWFR + L
-        IPE(I) = IWFR - 1
-  120 CONTINUE
-      IF (NZ.EQ.0) GO TO 250
-      DO 160 K = 1,NZ
-        I = -IW(K)
-        IF (I.LE.0) GO TO 160
-        L = K
-        IW(K) = 0
-        DO 150 ID = 1,NZ
-          J = ICN(L)
-          IF (PERM(I).LT.PERM(J)) GO TO 130
-          L = IPE(J)
-          IPE(J) = L - 1
-          IN = IW(L)
-          IW(L) = I
-          GO TO 140
-  130     L = IPE(I)
-          IPE(I) = L - 1
-          IN = IW(L)
-          IW(L) = J
-  140     I = -IN
-          IF (I.LE.0) GO TO 160
-  150   CONTINUE
-  160 CONTINUE
-      K = IWFR - 1
-      L = K + N
-      IWFR = L + 1
-      DO 190 I = 1,N
-        FLAG(I) = 0
-        J = N + 1 - I
-        LEN = IQ(J)
-        IF (LEN.LE.0) GO TO 180
-        DO 170 JDUMMY = 1,LEN
-          IW(L) = IW(K)
-          K = K - 1
-          L = L - 1
-  170   CONTINUE
-  180   IPE(J) = L
-        L = L - 1
-  190 CONTINUE
-      IF (LBIG.GE.IOVFLO) GO TO 210
-      DO 200 I = 1,N
-        K = IPE(I)
-        IW(K) = IQ(I)
-        IF (IQ(I).EQ.0) IPE(I) = 0
-  200 CONTINUE
-      GO TO 250
-  210 IWFR = 1
-      DO 240 I = 1,N
-        K1 = IPE(I) + 1
-        K2 = IPE(I) + IQ(I)
-        IF (K1.LE.K2) GO TO 220
-        IPE(I) = 0
-        GO TO 240
-  220   IPE(I) = IWFR
-        IWFR = IWFR + 1
-        DO 230 K = K1,K2
-          J = IW(K)
-          IF (FLAG(J).EQ.I) GO TO 230
-          IW(IWFR) = J
-          IWFR = IWFR + 1
-          FLAG(J) = I
-  230   CONTINUE
-        K = IPE(I)
-        IW(K) = IWFR - K - 1
-  240 CONTINUE
-  250 RETURN
-      END
-      SUBROUTINE MA27KD(N,IPE,IW,LW,IWFR,IPS,IPV,NV,FLAG)
-      INTEGER IWFR,LW,N
-      INTEGER FLAG(N),IPE(N),IPS(N),IPV(N),IW(LW),NV(N)
-      INTEGER I,IE,IP,J,JE,JP,JP1,JP2,JS,KDUMMY,LN,LWFR,ME,MINJS,ML,MS
-      EXTERNAL MA27ID
-      INTRINSIC MIN0
-      COMMON /MA27ED/OPS,IERROR,NRLTOT,NIRTOT,NRLNEC,NIRNEC,NRLADU,
-     +       NIRADU,NRLBDU,NIRBDU,NCMPA,NCMPBR,NCMPBI,NTWO,NEIG
-      DOUBLE PRECISION OPS
-      INTEGER IERROR,NCMPA,NCMPBI,NCMPBR,NEIG,NIRADU,NIRBDU,NIRNEC,
-     +        NIRTOT,NRLADU,NRLBDU,NRLNEC,NRLTOT,NTWO
-      SAVE /MA27ED/
-      DO 10 I = 1,N
-        FLAG(I) = 0
-        NV(I) = 0
-        J = IPS(I)
-        IPV(J) = I
-   10 CONTINUE
-      NCMPA = 0
-      DO 100 ML = 1,N
-        MS = IPV(ML)
-        ME = MS
-        FLAG(MS) = ME
-        IP = IWFR
-        MINJS = N
-        IE = ME
-        DO 70 KDUMMY = 1,N
-          JP = IPE(IE)
-          LN = 0
-          IF (JP.LE.0) GO TO 60
-          LN = IW(JP)
-          DO 50 JP1 = 1,LN
-            JP = JP + 1
-            JS = IW(JP)
-            IF (FLAG(JS).EQ.ME) GO TO 50
-            FLAG(JS) = ME
-            IF (IWFR.LT.LW) GO TO 40
-            IPE(IE) = JP
-            IW(JP) = LN - JP1
-            CALL MA27ID(N,IPE,IW,IP-1,LWFR)
-            JP2 = IWFR - 1
-            IWFR = LWFR
-            IF (IP.GT.JP2) GO TO 30
-            DO 20 JP = IP,JP2
-              IW(IWFR) = IW(JP)
-              IWFR = IWFR + 1
-   20       CONTINUE
-   30       IP = LWFR
-            JP = IPE(IE)
-   40       IW(IWFR) = JS
-            MINJS = MIN0(MINJS,IPS(JS)+0)
-            IWFR = IWFR + 1
-   50     CONTINUE
-   60     IPE(IE) = -ME
-          JE = NV(IE)
-          NV(IE) = LN + 1
-          IE = JE
-          IF (IE.EQ.0) GO TO 80
-   70   CONTINUE
-   80   IF (IWFR.GT.IP) GO TO 90
-        IPE(ME) = 0
-        NV(ME) = 1
-        GO TO 100
-   90   MINJS = IPV(MINJS)
-        NV(ME) = NV(MINJS)
-        NV(MINJS) = ME
-        IW(IWFR) = IW(IP)
-        IW(IP) = IWFR - IP
-        IPE(ME) = IP
-        IWFR = IWFR + 1
-  100 CONTINUE
-      RETURN
-      END
-      SUBROUTINE MA27LD(N,IPE,NV,IPS,NE,NA,ND,NSTEPS)
-      INTEGER N,NSTEPS
-      INTEGER IPE(N),IPS(N),NA(N),ND(N),NE(N),NV(N)
-      INTEGER I,IB,IF,IL,IS,ISON,K,L,NR
-      COMMON /MA27FD/IOVFLO,NEMIN,IFRLVL(20)
-      INTEGER IOVFLO,NEMIN
-      INTEGER IFRLVL
-      SAVE /MA27FD/
-      DO 10 I = 1,N
-        IPS(I) = 0
-        NE(I) = 0
-   10 CONTINUE
-      DO 20 I = 1,N
-        IF (NV(I).GT.0) GO TO 20
-        IF = -IPE(I)
-        IS = -IPS(IF)
-        IF (IS.GT.0) IPE(I) = IS
-        IPS(IF) = -I
-   20 CONTINUE
-      NR = N + 1
-      DO 50 I = 1,N
-        IF (NV(I).LE.0) GO TO 50
-        IF = -IPE(I)
-        IF (IF.EQ.0) GO TO 40
-        IS = -IPS(IF)
-        IF (IS.LE.0) GO TO 30
-        IPE(I) = IS
-   30   IPS(IF) = -I
-        GO TO 50
-   40   NR = NR - 1
-        NE(NR) = I
-   50 CONTINUE
-      IS = 1
-      I = 0
-      DO 160 K = 1,N
-        IF (I.GT.0) GO TO 60
-        I = NE(NR)
-        NE(NR) = 0
-        NR = NR + 1
-        IL = N
-        NA(N) = 0
-   60   DO 70 L = 1,N
-          IF (IPS(I).GE.0) GO TO 80
-          ISON = -IPS(I)
-          IPS(I) = 0
-          I = ISON
-          IL = IL - 1
-          NA(IL) = 0
-   70   CONTINUE
-   80   IPS(I) = K
-        NE(IS) = NE(IS) + 1
-        IF (NV(I).LE.0) GO TO 120
-        IF (IL.LT.N) NA(IL+1) = NA(IL+1) + 1
-        NA(IS) = NA(IL)
-        ND(IS) = NV(I)
-        IF (NA(IS).NE.1) GO TO 90
-        IF (ND(IS-1)-NE(IS-1).EQ.ND(IS)) GO TO 100
-   90   IF (NE(IS).GE.NEMIN) GO TO 110
-        IF (NA(IS).EQ.0) GO TO 110
-        IF (NE(IS-1).GE.NEMIN) GO TO 110
-  100   NA(IS-1) = NA(IS-1) + NA(IS) - 1
-        ND(IS-1) = ND(IS) + NE(IS-1)
-        NE(IS-1) = NE(IS) + NE(IS-1)
-        NE(IS) = 0
-        GO TO 120
-  110   IS = IS + 1
-  120   IB = IPE(I)
-        IF (IB) 150,140,130
-  130   NA(IL) = 0
-  140   I = IB
-        GO TO 160
-  150   I = -IB
-        IL = IL + 1
-  160 CONTINUE
-      NSTEPS = IS - 1
-      RETURN
-      END
-      SUBROUTINE MA27MD(N,NZ,IRN,ICN,PERM,NA,NE,ND,NSTEPS,LSTKI,LSTKR,
-     +                  IW)
-      INTEGER N,NSTEPS,NZ
-      INTEGER ICN(*),IRN(*),IW(*),LSTKI(N),LSTKR(N),NA(NSTEPS),
-     +        ND(NSTEPS),NE(NSTEPS),PERM(N)
-      INTEGER I,INEW,IOLD,IORG,IROW,ISTKI,ISTKR,ITOP,ITREE,JOLD,JORG,K,
-     +        LSTK,NASSR,NELIM,NFR,NSTK,NUMORG,NZ1,NZ2
-      DOUBLE PRECISION DELIM
-      INTRINSIC MAX0,MIN0
-      COMMON /MA27ED/OPS,IERROR,NRLTOT,NIRTOT,NRLNEC,NIRNEC,NRLADU,
-     +       NIRADU,NRLBDU,NIRBDU,NCMPA,NCMPBR,NCMPBI,NTWO,NEIG
-      DOUBLE PRECISION OPS
-      INTEGER IERROR,NCMPA,NCMPBI,NCMPBR,NEIG,NIRADU,NIRBDU,NIRNEC,
-     +        NIRTOT,NRLADU,NRLBDU,NRLNEC,NRLTOT,NTWO
-      SAVE /MA27ED/
-      IF (NZ.EQ.0) GO TO 20
-      IF (IRN(1).NE.IW(1)) GO TO 20
-      IRN(1) = IW(1) - 1
-      NZ2 = 0
-      DO 10 IOLD = 1,N
-        INEW = PERM(IOLD)
-        LSTKI(INEW) = LSTKR(IOLD) + 1
-        NZ2 = NZ2 + LSTKR(IOLD)
-   10 CONTINUE
-      NZ1 = NZ2/2 + N
-      NZ2 = NZ2 + N
-      GO TO 60
-   20 DO 30 I = 1,N
-        LSTKI(I) = 1
-   30 CONTINUE
-      NZ1 = N
-      IF (NZ.EQ.0) GO TO 50
-      DO 40 I = 1,NZ
-        IOLD = IRN(I)
-        JOLD = ICN(I)
-        IF (IOLD.LT.1 .OR. IOLD.GT.N) GO TO 40
-        IF (JOLD.LT.1 .OR. JOLD.GT.N) GO TO 40
-        IF (IOLD.EQ.JOLD) GO TO 40
-        NZ1 = NZ1 + 1
-        IROW = MIN0(PERM(IOLD)+0,PERM(JOLD)+0)
-        LSTKI(IROW) = LSTKI(IROW) + 1
-   40 CONTINUE
-   50 NZ2 = NZ1
-   60 ISTKI = 0
-      ISTKR = 0
-      OPS = 0.0D0
-      NRLADU = 0
-      NIRADU = 1
-      NIRTOT = NZ1
-      NRLTOT = NZ1
-      NIRNEC = NZ2
-      NRLNEC = NZ2
-      NUMORG = 0
-      ITOP = 0
-      DO 100 ITREE = 1,NSTEPS
-        NELIM = NE(ITREE)
-        DELIM = NELIM
-        NFR = ND(ITREE)
-        NSTK = NA(ITREE)
-        NASSR = NFR* (NFR+1)/2
-        IF (NSTK.NE.0) NASSR = NASSR - LSTKR(ITOP) + 1
-        NRLTOT = MAX0(NRLTOT,NRLADU+NASSR+ISTKR+NZ1)
-        NIRTOT = MAX0(NIRTOT,NIRADU+NFR+2+ISTKI+NZ1)
-        NRLNEC = MAX0(NRLNEC,NRLADU+NASSR+ISTKR+NZ2)
-        NIRNEC = MAX0(NIRNEC,NIRADU+NFR+2+ISTKI+NZ2)
-        DO 70 IORG = 1,NELIM
-          JORG = NUMORG + IORG
-          NZ2 = NZ2 - LSTKI(JORG)
-   70   CONTINUE
-        NUMORG = NUMORG + NELIM
-        IF (NSTK.LE.0) GO TO 90
-        DO 80 K = 1,NSTK
-          LSTK = LSTKR(ITOP)
-          ISTKR = ISTKR - LSTK
-          LSTK = LSTKI(ITOP)
-          ISTKI = ISTKI - LSTK
-          ITOP = ITOP - 1
-   80   CONTINUE
-   90   NRLADU = NRLADU + (NELIM* (2*NFR-NELIM+1))/2
-        NIRADU = NIRADU + 2 + NFR
-        IF (NELIM.EQ.1) NIRADU = NIRADU - 1
-        OPS = OPS + ((NFR*DELIM* (NFR+1)- (2*NFR+1)*DELIM* (DELIM+1)/2+
-     +        DELIM* (DELIM+1)* (2*DELIM+1)/6)/2)
-        IF (ITREE.EQ.NSTEPS) GO TO 100
-        IF (NFR.EQ.NELIM) GO TO 100
-        ITOP = ITOP + 1
-        LSTKR(ITOP) = (NFR-NELIM)* (NFR-NELIM+1)/2
-        LSTKI(ITOP) = NFR - NELIM + 1
-        ISTKI = ISTKI + LSTKI(ITOP)
-        ISTKR = ISTKR + LSTKR(ITOP)
-        NIRTOT = MAX0(NIRTOT,NIRADU+ISTKI+NZ1)
-        NIRNEC = MAX0(NIRNEC,NIRADU+ISTKI+NZ2)
-  100 CONTINUE
-      NRLNEC = MAX0(NRLNEC,N+MAX0(NZ,NZ1))
-      NRLTOT = MAX0(NRLTOT,N+MAX0(NZ,NZ1))
-      NRLNEC = MIN0(NRLNEC,NRLTOT)
-      NIRNEC = MAX0(NZ,NIRNEC)
-      NIRTOT = MAX0(NZ,NIRTOT)
-      NIRNEC = MIN0(NIRNEC,NIRTOT)
-      RETURN
-      END
-      SUBROUTINE MA27ND(N,NZ,NZ1,A,LA,IRN,ICN,IW,LIW,PERM,IW2,IFLAG)
-      DOUBLE PRECISION ZERO
-      PARAMETER (ZERO=0.0D0)
-      INTEGER IFLAG,LA,LIW,N,NZ,NZ1
-      DOUBLE PRECISION A(LA)
-      INTEGER ICN(*),IRN(*),IW(LIW),IW2(N),PERM(N)
-      DOUBLE PRECISION ANEXT,ANOW
-      INTEGER I,IA,ICH,II,IIW,INEW,IOLD,IPOS,J1,J2,JJ,JNEW,JOLD,JPOS,K
-      INTRINSIC MIN0
-      COMMON /MA27DD/U,LP,MP,LDIAG
-      COMMON /MA27ED/OPS,IERROR,NRLTOT,NIRTOT,NRLNEC,NIRNEC,NRLADU,
-     +       NIRADU,NRLBDU,NIRBDU,NCMPA,NCMPBR,NCMPBI,NTWO,NEIG
-      DOUBLE PRECISION OPS,U
-      INTEGER IERROR,LDIAG,LP,MP,NCMPA,NCMPBI,NCMPBR,NEIG,NIRADU,NIRBDU,
-     +        NIRNEC,NIRTOT,NRLADU,NRLBDU,NRLNEC,NRLTOT,NTWO
-      SAVE /MA27DD/,/MA27ED/
-      IFLAG = 0
-      IA = LA
-      DO 10 IOLD = 1,N
-        IW2(IOLD) = 1
-        A(IA) = ZERO
-        IA = IA - 1
-   10 CONTINUE
-      IERROR = 0
-      NZ1 = N
-      IF (NZ.EQ.0) GO TO 80
-      DO 70 K = 1,NZ
-        IOLD = IRN(K)
-        IF (IOLD.GT.N .OR. IOLD.LE.0) GO TO 30
-        JOLD = ICN(K)
-        IF (JOLD.GT.N .OR. JOLD.LE.0) GO TO 30
-        INEW = PERM(IOLD)
-        JNEW = PERM(JOLD)
-        IF (INEW.NE.JNEW) GO TO 20
-        IA = LA - N + IOLD
-        A(IA) = A(IA) + A(K)
-        GO TO 60
-   20   INEW = MIN0(INEW,JNEW)
-        IW2(INEW) = IW2(INEW) + 1
-        IW(K) = -IOLD
-        NZ1 = NZ1 + 1
-        GO TO 70
-   30   IFLAG = 1
-        IERROR = IERROR + 1
-        IF (IERROR.LE.1 .AND. MP.GT.0) WRITE (MP,FMT=40) IFLAG
-   40   FORMAT (52H *** WARNING MESSAGE FROM SUBROUTINE MA27BD *** IFLA,
-     +         3HG =,I2)
-        IF (IERROR.LE.10 .AND. MP.GT.0) WRITE (MP,FMT=50) K,IRN(K),
-     +      ICN(K)
-   50   FORMAT (I6,19HTH NON-ZERO (IN ROW,I6,11H AND COLUMN,I6,
-     +         9H) IGNORED)
-   60   IW(K) = 0
-   70 CONTINUE
-   80 IF (NZ.LT.NZ1 .AND. NZ1.NE.N) GO TO 100
-      K = 1
-      DO 90 I = 1,N
-        K = K + IW2(I)
-        IW2(I) = K
-   90 CONTINUE
-      GO TO 120
-  100 K = 1
-      DO 110 I = 1,N
-        K = K + IW2(I) - 1
-        IW2(I) = K
-  110 CONTINUE
-  120 IF (NZ1.GT.LIW) GO TO 210
-      IF (NZ1+N.GT.LA) GO TO 220
-      IF (NZ1.EQ.N) GO TO 180
-      DO 140 K = 1,NZ
-        IOLD = -IW(K)
-        IF (IOLD.LE.0) GO TO 140
-        JOLD = ICN(K)
-        ANOW = A(K)
-        IW(K) = 0
-        DO 130 ICH = 1,NZ
-          INEW = PERM(IOLD)
-          JNEW = PERM(JOLD)
-          INEW = MIN0(INEW,JNEW)
-          IF (INEW.EQ.PERM(JOLD)) JOLD = IOLD
-          JPOS = IW2(INEW) - 1
-          IOLD = -IW(JPOS)
-          ANEXT = A(JPOS)
-          A(JPOS) = ANOW
-          IW(JPOS) = JOLD
-          IW2(INEW) = JPOS
-          IF (IOLD.EQ.0) GO TO 140
-          ANOW = ANEXT
-          JOLD = ICN(JPOS)
-  130   CONTINUE
-  140 CONTINUE
-      IF (NZ.GE.NZ1) GO TO 180
-      IPOS = NZ1
-      JPOS = NZ1 - N
-      DO 170 II = 1,N
-        I = N - II + 1
-        J1 = IW2(I)
-        J2 = JPOS
-        IF (J1.GT.JPOS) GO TO 160
-        DO 150 JJ = J1,J2
-          IW(IPOS) = IW(JPOS)
-          A(IPOS) = A(JPOS)
-          IPOS = IPOS - 1
-          JPOS = JPOS - 1
-  150   CONTINUE
-  160   IW2(I) = IPOS + 1
-        IPOS = IPOS - 1
-  170 CONTINUE
-  180 DO 190 IOLD = 1,N
-        INEW = PERM(IOLD)
-        JPOS = IW2(INEW) - 1
-        IA = LA - N + IOLD
-        A(JPOS) = A(IA)
-        IW(JPOS) = -IOLD
-  190 CONTINUE
-      IPOS = NZ1
-      IA = LA
-      IIW = LIW
-      DO 200 I = 1,NZ1
-        A(IA) = A(IPOS)
-        IW(IIW) = IW(IPOS)
-        IPOS = IPOS - 1
-        IA = IA - 1
-        IIW = IIW - 1
-  200 CONTINUE
-      GO TO 230
-  210 IFLAG = -3
-      IERROR = NZ1
-      GO TO 230
-  220 IFLAG = -4
-      IERROR = NZ1 + N
-  230 RETURN
-      END
-      SUBROUTINE MA27OD(N,NZ,A,LA,IW,LIW,PERM,NSTK,NSTEPS,MAXFRT,NELIM,
-     +                  IW2,IFLAG)
-      DOUBLE PRECISION ZERO,HALF,ONE
-      PARAMETER (ZERO=0.0D0,HALF=0.5D0,ONE=1.0D0)
-      INTEGER IFLAG,LA,LIW,MAXFRT,N,NSTEPS,NZ
-      DOUBLE PRECISION A(LA)
-      INTEGER IW(LIW),IW2(N),NELIM(NSTEPS),NSTK(NSTEPS),PERM(N)
-      DOUBLE PRECISION AMAX,AMULT,AMULT1,AMULT2,DETPIV,RMAX,SWOP,THRESH,
-     +                 TMAX,UU
-      INTEGER AINPUT,APOS,APOS1,APOS2,APOS3,ASTK,ASTK2,AZERO,I,IASS,
-     +        IBEG,IDUMMY,IELL,IEND,IEXCH,IFR,IINPUT,IOLDPS,IORG,IPIV,
-     +        IPMNP,IPOS,IROW,ISNPIV,ISTK,ISTK2,ISWOP,IWPOS,IX,IY,J,J1,
-     +        J2,JCOL,JDUMMY,JFIRST,JJ,JJ1,JJJ,JLAST,JMAX,JMXMIP,JNEW,
-     +        JNEXT,JPIV,JPOS,K,K1,K2,KDUMMY,KK,KMAX,KROW,LAELL,LAPOS2,
-     +        LIELL,LNASS,LNPIV,LT,LTOPST,NASS,NBLK,NEWEL,NFRONT,NPIV,
-     +        NPIVP1,NTOTPV,NUMASS,NUMORG,NUMSTK,PIVSIZ,POSFAC,POSPV1,
-     +        POSPV2
-      EXTERNAL MA27PD
-      INTRINSIC DABS,DMAX1,DMIN1,MAX0,MIN0
-      COMMON /MA27DD/U,LP,MP,LDIAG
-      COMMON /MA27ED/OPS,IERROR,NRLTOT,NIRTOT,NRLNEC,NIRNEC,NRLADU,
-     +       NIRADU,NRLBDU,NIRBDU,NCMPA,NCMPBR,NCMPBI,NTWO,NEIG
-      DOUBLE PRECISION OPS,U
-      INTEGER IERROR,LDIAG,LP,MP,NCMPA,NCMPBI,NCMPBR,NEIG,NIRADU,NIRBDU,
-     +        NIRNEC,NIRTOT,NRLADU,NRLBDU,NRLNEC,NRLTOT,NTWO
-      COMMON /MA27TD/FRATIO,PIVTOL
-      DOUBLE PRECISION FRATIO,PIVTOL
-      INTEGER IDIAG
-      SAVE /MA27DD/,/MA27ED/,/MA27TD/
-      IDIAG(IX,IY) = ((IY-1)* (2*IX-IY+2))/2
-      NBLK = 0
-      NTWO = 0
-      NEIG = 0
-      NCMPBI = 0
-      NCMPBR = 0
-      MAXFRT = 0
-      UU = DMIN1(U,HALF)
-      UU = DMAX1(UU,-HALF)
-      DO 10 I = 1,N
-        IW2(I) = 0
-   10 CONTINUE
-      IWPOS = 2
-      POSFAC = 1
-      ISTK = LIW - NZ + 1
-      ISTK2 = ISTK - 1
-      ASTK = LA - NZ + 1
-      ASTK2 = ASTK - 1
-      IINPUT = ISTK
-      AINPUT = ASTK
-      AZERO = 0
-      NTOTPV = 0
-      NUMASS = 0
-      DO 760 IASS = 1,NSTEPS
-        NASS = NELIM(IASS)
-        NEWEL = IWPOS + 1
-        JFIRST = N + 1
-        NFRONT = 0
-        NUMSTK = NSTK(IASS)
-        LTOPST = 1
-        LNASS = 0
-        IF (NUMSTK.EQ.0) GO TO 80
-        J2 = ISTK - 1
-        LNASS = NASS
-        LTOPST = ((IW(ISTK)+1)*IW(ISTK))/2
-        DO 70 IELL = 1,NUMSTK
-          JNEXT = JFIRST
-          JLAST = N + 1
-          J1 = J2 + 2
-          J2 = J1 - 1 + IW(J1-1)
-          DO 60 JJ = J1,J2
-            J = IW(JJ)
-            IF (IW2(J).GT.0) GO TO 60
-            JNEW = PERM(J)
-            IF (JNEW.LE.NUMASS) NASS = NASS + 1
-            DO 20 IDUMMY = 1,N
-              IF (JNEXT.EQ.N+1) GO TO 30
-              IF (PERM(JNEXT).GT.JNEW) GO TO 30
-              JLAST = JNEXT
-              JNEXT = IW2(JLAST)
-   20       CONTINUE
-   30       IF (JLAST.NE.N+1) GO TO 40
-            JFIRST = J
-            GO TO 50
-   40       IW2(JLAST) = J
-   50       IW2(J) = JNEXT
-            JLAST = J
-            NFRONT = NFRONT + 1
-   60     CONTINUE
-   70   CONTINUE
-        LNASS = NASS - LNASS
-   80   NUMORG = NELIM(IASS)
-        J1 = IINPUT
-        DO 150 IORG = 1,NUMORG
-          J = -IW(J1)
-          DO 140 IDUMMY = 1,LIW
-            JNEW = PERM(J)
-            IF (IW2(J).GT.0) GO TO 130
-            JLAST = N + 1
-            JNEXT = JFIRST
-            DO 90 JDUMMY = 1,N
-              IF (JNEXT.EQ.N+1) GO TO 100
-              IF (PERM(JNEXT).GT.JNEW) GO TO 100
-              JLAST = JNEXT
-              JNEXT = IW2(JLAST)
-   90       CONTINUE
-  100       IF (JLAST.NE.N+1) GO TO 110
-            JFIRST = J
-            GO TO 120
-  110       IW2(JLAST) = J
-  120       IW2(J) = JNEXT
-            NFRONT = NFRONT + 1
-  130       J1 = J1 + 1
-            IF (J1.GT.LIW) GO TO 150
-            J = IW(J1)
-            IF (J.LT.0) GO TO 150
-  140     CONTINUE
-  150   CONTINUE
-        IF (NEWEL+NFRONT.LT.ISTK) GO TO 160
-        CALL MA27PD(A,IW,ISTK,ISTK2,IINPUT,2)
-        IF (NEWEL+NFRONT.LT.ISTK) GO TO 160
-        IERROR = LIW + 1 + NEWEL + NFRONT - ISTK
-        GO TO 770
-  160   J = JFIRST
-        DO 170 IFR = 1,NFRONT
-          NEWEL = NEWEL + 1
-          IW(NEWEL) = J
-          JNEXT = IW2(J)
-          IW2(J) = NEWEL - (IWPOS+1)
-          J = JNEXT
-  170   CONTINUE
-        MAXFRT = MAX0(MAXFRT,NFRONT)
-        IW(IWPOS) = NFRONT
-        LAELL = ((NFRONT+1)*NFRONT)/2
-        APOS2 = POSFAC + LAELL - 1
-        IF (NUMSTK.NE.0) LNASS = LNASS* (2*NFRONT-LNASS+1)/2
-        IF (POSFAC+LNASS-1.GE.ASTK) GO TO 180
-        IF (APOS2.LT.ASTK+LTOPST-1) GO TO 190
-  180   CALL MA27PD(A,IW,ASTK,ASTK2,AINPUT,1)
-        IF (POSFAC+LNASS-1.GE.ASTK) GO TO 780
-        IF (APOS2.GE.ASTK+LTOPST-1) GO TO 780
-  190   IF (APOS2.LE.AZERO) GO TO 220
-        APOS = AZERO + 1
-        LAPOS2 = MIN0(APOS2,ASTK-1)
-        IF (LAPOS2.LT.APOS) GO TO 210
-        DO 200 K = APOS,LAPOS2
-          A(K) = ZERO
-  200   CONTINUE
-  210   AZERO = APOS2
-  220   IF (NUMSTK.EQ.0) GO TO 260
-        DO 250 IELL = 1,NUMSTK
-          J1 = ISTK + 1
-          J2 = ISTK + IW(ISTK)
-          DO 240 JJ = J1,J2
-            IROW = IW(JJ)
-            IROW = IW2(IROW)
-            APOS = POSFAC + IDIAG(NFRONT,IROW)
-            DO 230 JJJ = JJ,J2
-              J = IW(JJJ)
-              APOS2 = APOS + IW2(J) - IROW
-              A(APOS2) = A(APOS2) + A(ASTK)
-              A(ASTK) = ZERO
-              ASTK = ASTK + 1
-  230       CONTINUE
-  240     CONTINUE
-          ISTK = J2 + 1
-  250   CONTINUE
-  260   DO 280 IORG = 1,NUMORG
-          J = -IW(IINPUT)
-          IROW = IW2(J)
-          APOS = POSFAC + IDIAG(NFRONT,IROW)
-          DO 270 IDUMMY = 1,NZ
-            APOS2 = APOS + IW2(J) - IROW
-            A(APOS2) = A(APOS2) + A(AINPUT)
-            AINPUT = AINPUT + 1
-            IINPUT = IINPUT + 1
-            IF (IINPUT.GT.LIW) GO TO 280
-            J = IW(IINPUT)
-            IF (J.LT.0) GO TO 280
-  270     CONTINUE
-  280   CONTINUE
-        NUMASS = NUMASS + NUMORG
-        J1 = IWPOS + 2
-        J2 = IWPOS + NFRONT + 1
-        DO 290 K = J1,J2
-          J = IW(K)
-          IW2(J) = 0
-  290   CONTINUE
-        LNPIV = -1
-        NPIV = 0
-        DO 650 KDUMMY = 1,NASS
-          IF (NPIV.EQ.NASS) GO TO 660
-          IF (NPIV.EQ.LNPIV) GO TO 660
-          LNPIV = NPIV
-          NPIVP1 = NPIV + 1
-          JPIV = 1
-          DO 640 IPIV = NPIVP1,NASS
-            JPIV = JPIV - 1
-            IF (JPIV.EQ.1) GO TO 640
-            APOS = POSFAC + IDIAG(NFRONT-NPIV,IPIV-NPIV)
-            IF (UU.GT.ZERO) GO TO 320
-            IF (ABS(A(APOS)).LE.PIVTOL) GO TO 790
-            IF (NTOTPV.GT.0) GO TO 300
-            IF (A(APOS).GT.ZERO) ISNPIV = 1
-            IF (A(APOS).LT.ZERO) ISNPIV = -1
-  300       IF (A(APOS).GT.ZERO .AND. ISNPIV.EQ.1) GO TO 560
-            IF (A(APOS).LT.ZERO .AND. ISNPIV.EQ.-1) GO TO 560
-            IF (IFLAG.NE.2) IERROR = 0
-            IERROR = IERROR + 1
-            IFLAG = 2
-            I = NTOTPV + 1
-            IF (MP.GT.0 .AND. IERROR.LE.10) WRITE (MP,FMT=310) IFLAG,I
-  310       FORMAT (48H *** WARNING MESSAGE FROM SUBROUTINE MA27BD *** ,
-     +             7HIFLAG =,I2,/,6H PIVOT,I6,
-     +             27H HAS DIFFERENT SIGN FROM TH,10HE PREVIOUS,4H ONE)
-            ISNPIV = -ISNPIV
-            IF (UU.EQ.ZERO) GO TO 560
-            GO TO 800
-  320       AMAX = ZERO
-            TMAX = AMAX
-            J1 = APOS + 1
-            J2 = APOS + NASS - IPIV
-            IF (J2.LT.J1) GO TO 340
-            DO 330 JJ = J1,J2
-              IF (DABS(A(JJ)).LE.AMAX) GO TO 330
-              JMAX = IPIV + JJ - J1 + 1
-              AMAX = DABS(A(JJ))
-  330       CONTINUE
-  340       J1 = J2 + 1
-            J2 = APOS + NFRONT - IPIV
-            IF (J2.LT.J1) GO TO 360
-            DO 350 JJ = J1,J2
-              TMAX = DMAX1(DABS(A(JJ)),TMAX)
-  350       CONTINUE
-  360       RMAX = DMAX1(TMAX,AMAX)
-            APOS1 = APOS
-            KK = NFRONT - IPIV
-            LT = IPIV - (NPIV+1)
-            IF (LT.EQ.0) GO TO 380
-            DO 370 K = 1,LT
-              KK = KK + 1
-              APOS1 = APOS1 - KK
-              RMAX = DMAX1(RMAX,DABS(A(APOS1)))
-  370       CONTINUE
-  380       IF (DABS(A(APOS)).GT.MAX(PIVTOL,UU*RMAX)) GO TO 450
-            IF (ABS(AMAX).LE.PIVTOL) GO TO 640
-            APOS2 = POSFAC + IDIAG(NFRONT-NPIV,JMAX-NPIV)
-            DETPIV = A(APOS)*A(APOS2) - AMAX*AMAX
-            THRESH = DABS(DETPIV)
-            THRESH = THRESH/ (UU*DMAX1(DABS(A(APOS))+AMAX,
-     +               DABS(A(APOS2))+AMAX))
-            IF (THRESH.LE.RMAX) GO TO 640
-            RMAX = ZERO
-            J1 = APOS2 + 1
-            J2 = APOS2 + NFRONT - JMAX
-            IF (J2.LT.J1) GO TO 400
-            DO 390 JJ = J1,J2
-              RMAX = DMAX1(RMAX,DABS(A(JJ)))
-  390       CONTINUE
-  400       KK = NFRONT - JMAX + 1
-            APOS3 = APOS2
-            JMXMIP = JMAX - IPIV - 1
-            IF (JMXMIP.EQ.0) GO TO 420
-            DO 410 K = 1,JMXMIP
-              APOS2 = APOS2 - KK
-              KK = KK + 1
-              RMAX = DMAX1(RMAX,DABS(A(APOS2)))
-  410       CONTINUE
-  420       IPMNP = IPIV - NPIV - 1
-            IF (IPMNP.EQ.0) GO TO 440
-            APOS2 = APOS2 - KK
-            KK = KK + 1
-            DO 430 K = 1,IPMNP
-              APOS2 = APOS2 - KK
-              KK = KK + 1
-              RMAX = DMAX1(RMAX,DABS(A(APOS2)))
-  430       CONTINUE
-  440       IF (THRESH.LE.RMAX) GO TO 640
-            PIVSIZ = 2
-            GO TO 460
-  450       PIVSIZ = 1
-  460       IROW = IPIV - NPIV
-            DO 550 KROW = 1,PIVSIZ
-              IF (IROW.EQ.1) GO TO 530
-              J1 = POSFAC + IROW
-              J2 = POSFAC + NFRONT - (NPIV+1)
-              IF (J2.LT.J1) GO TO 480
-              APOS2 = APOS + 1
-              DO 470 JJ = J1,J2
-                SWOP = A(APOS2)
-                A(APOS2) = A(JJ)
-                A(JJ) = SWOP
-                APOS2 = APOS2 + 1
-  470         CONTINUE
-  480         J1 = POSFAC + 1
-              J2 = POSFAC + IROW - 2
-              APOS2 = APOS
-              KK = NFRONT - (IROW+NPIV)
-              IF (J2.LT.J1) GO TO 500
-              DO 490 JJJ = J1,J2
-                JJ = J2 - JJJ + J1
-                KK = KK + 1
-                APOS2 = APOS2 - KK
-                SWOP = A(APOS2)
-                A(APOS2) = A(JJ)
-                A(JJ) = SWOP
-  490         CONTINUE
-  500         IF (NPIV.EQ.0) GO TO 520
-              APOS1 = POSFAC
-              KK = KK + 1
-              APOS2 = APOS2 - KK
-              DO 510 JJ = 1,NPIV
-                KK = KK + 1
-                APOS1 = APOS1 - KK
-                APOS2 = APOS2 - KK
-                SWOP = A(APOS2)
-                A(APOS2) = A(APOS1)
-                A(APOS1) = SWOP
-  510         CONTINUE
-  520         SWOP = A(APOS)
-              A(APOS) = A(POSFAC)
-              A(POSFAC) = SWOP
-              IPOS = IWPOS + NPIV + 2
-              IEXCH = IWPOS + IROW + NPIV + 1
-              ISWOP = IW(IPOS)
-              IW(IPOS) = IW(IEXCH)
-              IW(IEXCH) = ISWOP
-  530         IF (PIVSIZ.EQ.1) GO TO 550
-              IF (KROW.EQ.2) GO TO 540
-              IROW = JMAX - (NPIV+1)
-              JPOS = POSFAC
-              POSFAC = POSFAC + NFRONT - NPIV
-              NPIV = NPIV + 1
-              APOS = APOS3
-              GO TO 550
-  540         NPIV = NPIV - 1
-              POSFAC = JPOS
-  550       CONTINUE
-            IF (PIVSIZ.EQ.2) GO TO 600
-  560       A(POSFAC) = ONE/A(POSFAC)
-            IF (A(POSFAC).LT.ZERO) NEIG = NEIG + 1
-            J1 = POSFAC + 1
-            J2 = POSFAC + NFRONT - (NPIV+1)
-            IF (J2.LT.J1) GO TO 590
-            IBEG = J2 + 1
-            DO 580 JJ = J1,J2
-              AMULT = -A(JJ)*A(POSFAC)
-              IEND = IBEG + NFRONT - (NPIV+JJ-J1+2)
-CDIR$ IVDEP
-              DO 570 IROW = IBEG,IEND
-                JCOL = JJ + IROW - IBEG
-                A(IROW) = A(IROW) + AMULT*A(JCOL)
-  570         CONTINUE
-              IBEG = IEND + 1
-              A(JJ) = AMULT
-  580       CONTINUE
-  590       NPIV = NPIV + 1
-            NTOTPV = NTOTPV + 1
-            JPIV = 1
-            POSFAC = POSFAC + NFRONT - NPIV + 1
-            GO TO 640
-  600       IPOS = IWPOS + NPIV + 2
-            NTWO = NTWO + 1
-            IW(IPOS) = -IW(IPOS)
-            POSPV1 = POSFAC
-            POSPV2 = POSFAC + NFRONT - NPIV
-            SWOP = A(POSPV2)
-            IF (DETPIV.LT.ZERO) NEIG = NEIG + 1
-            IF (DETPIV.GT.ZERO .AND. SWOP.LT.ZERO) NEIG = NEIG + 2
-            A(POSPV2) = A(POSPV1)/DETPIV
-            A(POSPV1) = SWOP/DETPIV
-            A(POSPV1+1) = -A(POSPV1+1)/DETPIV
-            J1 = POSPV1 + 2
-            J2 = POSPV1 + NFRONT - (NPIV+1)
-            IF (J2.LT.J1) GO TO 630
-            JJ1 = POSPV2
-            IBEG = POSPV2 + NFRONT - (NPIV+1)
-            DO 620 JJ = J1,J2
-              JJ1 = JJ1 + 1
-              AMULT1 = - (A(POSPV1)*A(JJ)+A(POSPV1+1)*A(JJ1))
-              AMULT2 = - (A(POSPV1+1)*A(JJ)+A(POSPV2)*A(JJ1))
-              IEND = IBEG + NFRONT - (NPIV+JJ-J1+3)
-CDIR$ IVDEP
-              DO 610 IROW = IBEG,IEND
-                K1 = JJ + IROW - IBEG
-                K2 = JJ1 + IROW - IBEG
-                A(IROW) = A(IROW) + AMULT1*A(K1) + AMULT2*A(K2)
-  610         CONTINUE
-              IBEG = IEND + 1
-              A(JJ) = AMULT1
-              A(JJ1) = AMULT2
-  620       CONTINUE
-  630       NPIV = NPIV + 2
-            NTOTPV = NTOTPV + 2
-            JPIV = 2
-            POSFAC = POSPV2 + NFRONT - NPIV + 1
-  640     CONTINUE
-  650   CONTINUE
-  660   IF (NPIV.NE.0) NBLK = NBLK + 1
-        IOLDPS = IWPOS
-        IWPOS = IWPOS + NFRONT + 2
-        IF (NPIV.EQ.0) GO TO 690
-        IF (NPIV.GT.1) GO TO 680
-        IW(IOLDPS) = -IW(IOLDPS)
-        DO 670 K = 1,NFRONT
-          J1 = IOLDPS + K
-          IW(J1) = IW(J1+1)
-  670   CONTINUE
-        IWPOS = IWPOS - 1
-        GO TO 690
-  680   IW(IOLDPS+1) = NPIV
-  690   LIELL = NFRONT - NPIV
-        IF (LIELL.EQ.0 .OR. IASS.EQ.NSTEPS) GO TO 750
-        IF (IWPOS+LIELL.LT.ISTK) GO TO 700
-        CALL MA27PD(A,IW,ISTK,ISTK2,IINPUT,2)
-  700   ISTK = ISTK - LIELL - 1
-        IW(ISTK) = LIELL
-        J1 = ISTK
-        KK = IWPOS - LIELL - 1
-CDIR$ IVDEP
-        DO 710 K = 1,LIELL
-          J1 = J1 + 1
-          KK = KK + 1
-          IW(J1) = IW(KK)
-  710   CONTINUE
-        LAELL = ((LIELL+1)*LIELL)/2
-        KK = POSFAC + LAELL
-        IF (KK.NE.ASTK) GO TO 720
-        ASTK = ASTK - LAELL
-        GO TO 740
-  720   KMAX = KK - 1
-CDIR$ IVDEP
-        DO 730 K = 1,LAELL
-          KK = KK - 1
-          ASTK = ASTK - 1
-          A(ASTK) = A(KK)
-  730   CONTINUE
-        KMAX = MIN0(KMAX,ASTK-1)
-        DO 735 K = KK,KMAX
-          A(K) = ZERO
-  735   CONTINUE
-  740   AZERO = MIN0(AZERO,ASTK-1)
-  750   IF (NPIV.EQ.0) IWPOS = IOLDPS
-  760 CONTINUE
-      IW(1) = NBLK
-      IF (NTWO.GT.0) IW(1) = -NBLK
-      NRLBDU = POSFAC - 1
-      NIRBDU = IWPOS - 1
-      IF (NTOTPV.EQ.N) GO TO 810
-      IFLAG = 3
-      IERROR = NTOTPV
-      GO TO 810
-  770 IFLAG = -3
-      GO TO 810
-  780 IFLAG = -4
-      IERROR = LA + MAX0(POSFAC+LNASS,APOS2-LTOPST+2) - ASTK
-      GO TO 810
-  790 IFLAG = -5
-      IERROR = NTOTPV + 1
-      GO TO 810
-  800 IFLAG = -6
-      IERROR = NTOTPV + 1
-  810 RETURN
-      END
-      SUBROUTINE MA27PD(A,IW,J1,J2,ITOP,IREAL)
-      INTEGER IREAL,ITOP,J1,J2
-      DOUBLE PRECISION A(*)
-      INTEGER IW(*)
-      INTEGER IPOS,JJ,JJJ
-      COMMON /MA27ED/OPS,IERROR,NRLTOT,NIRTOT,NRLNEC,NIRNEC,NRLADU,
-     +       NIRADU,NRLBDU,NIRBDU,NCMPA,NCMPBR,NCMPBI,NTWO,NEIG
-      DOUBLE PRECISION OPS
-      INTEGER IERROR,NCMPA,NCMPBI,NCMPBR,NEIG,NIRADU,NIRBDU,NIRNEC,
-     +        NIRTOT,NRLADU,NRLBDU,NRLNEC,NRLTOT,NTWO
-      SAVE /MA27ED/
-      IPOS = ITOP - 1
-      IF (J2.EQ.IPOS) GO TO 50
-      IF (IREAL.EQ.2) GO TO 20
-      NCMPBR = NCMPBR + 1
-      IF (J1.GT.J2) GO TO 40
-      DO 10 JJJ = J1,J2
-        JJ = J2 - JJJ + J1
-        A(IPOS) = A(JJ)
-        IPOS = IPOS - 1
-   10 CONTINUE
-      GO TO 40
-   20 NCMPBI = NCMPBI + 1
-      IF (J1.GT.J2) GO TO 40
-      DO 30 JJJ = J1,J2
-        JJ = J2 - JJJ + J1
-        IW(IPOS) = IW(JJ)
-        IPOS = IPOS - 1
-   30 CONTINUE
-   40 J2 = ITOP - 1
-      J1 = IPOS + 1
-   50 RETURN
-      END
-      SUBROUTINE MA27QD(N,A,LA,IW,LIW,W,MAXFNT,RHS,IW2,NBLK,LATOP)
-      INTEGER LA,LATOP,LIW,MAXFNT,N,NBLK
-      DOUBLE PRECISION A(LA),RHS(N),W(MAXFNT)
-      INTEGER IW(LIW),IW2(NBLK)
-      DOUBLE PRECISION W1,W2
-      INTEGER APOS,IBLK,IFR,ILVL,IPIV,IPOS,IRHS,IROW,IST,J,J1,J2,J3,JJ,
-     +        JPIV,K,K1,K2,K3,LIELL,NPIV
-      INTRINSIC IABS,MIN0
-      COMMON /MA27FD/IOVFLO,NEMIN,IFRLVL(20)
-      INTEGER IOVFLO,NEMIN
-      INTEGER IFRLVL
-      SAVE /MA27FD/
-      APOS = 1
-      IPOS = 1
-      J2 = 0
-      IBLK = 0
-      NPIV = 0
-      DO 140 IROW = 1,N
-        IF (NPIV.GT.0) GO TO 90
-        IBLK = IBLK + 1
-        IF (IBLK.GT.NBLK) GO TO 150
-        IPOS = J2 + 1
-        IW2(IBLK) = IPOS
-        LIELL = -IW(IPOS)
-        NPIV = 1
-        IF (LIELL.GT.0) GO TO 10
-        LIELL = -LIELL
-        IPOS = IPOS + 1
-        NPIV = IW(IPOS)
-   10   J1 = IPOS + 1
-        J2 = IPOS + LIELL
-        ILVL = MIN0(NPIV,10)
-        IF (LIELL.LT.IFRLVL(ILVL)) GO TO 90
-        IFR = 0
-        DO 20 JJ = J1,J2
-          J = IABS(IW(JJ)+0)
-          IFR = IFR + 1
-          W(IFR) = RHS(J)
-   20   CONTINUE
-        JPIV = 1
-        J3 = J1
-        DO 70 IPIV = 1,NPIV
-          JPIV = JPIV - 1
-          IF (JPIV.EQ.1) GO TO 70
-          IF (IW(J3).LT.0) GO TO 40
-          JPIV = 1
-          J3 = J3 + 1
-          APOS = APOS + 1
-          IST = IPIV + 1
-          IF (LIELL.LT.IST) GO TO 70
-          W1 = W(IPIV)
-          K = APOS
-          DO 30 J = IST,LIELL
-            W(J) = W(J) + A(K)*W1
-            K = K + 1
-   30     CONTINUE
-          APOS = APOS + LIELL - IST + 1
-          GO TO 70
-   40     JPIV = 2
-          J3 = J3 + 2
-          APOS = APOS + 2
-          IST = IPIV + 2
-          IF (LIELL.LT.IST) GO TO 60
-          W1 = W(IPIV)
-          W2 = W(IPIV+1)
-          K1 = APOS
-          K2 = APOS + LIELL - IPIV
-          DO 50 J = IST,LIELL
-            W(J) = W(J) + W1*A(K1) + W2*A(K2)
-            K1 = K1 + 1
-            K2 = K2 + 1
-   50     CONTINUE
-   60     APOS = APOS + 2* (LIELL-IST+1) + 1
-   70   CONTINUE
-        IFR = 0
-        DO 80 JJ = J1,J2
-          J = IABS(IW(JJ)+0)
-          IFR = IFR + 1
-          RHS(J) = W(IFR)
-   80   CONTINUE
-        NPIV = 0
-        GO TO 140
-   90   IF (IW(J1).LT.0) GO TO 110
-        NPIV = NPIV - 1
-        APOS = APOS + 1
-        J1 = J1 + 1
-        IF (J1.GT.J2) GO TO 140
-        IRHS = IW(J1-1)
-        W1 = RHS(IRHS)
-        K = APOS
-        DO 100 J = J1,J2
-          IRHS = IABS(IW(J)+0)
-          RHS(IRHS) = RHS(IRHS) + A(K)*W1
-          K = K + 1
-  100   CONTINUE
-        APOS = APOS + J2 - J1 + 1
-        GO TO 140
-  110   NPIV = NPIV - 2
-        J1 = J1 + 2
-        APOS = APOS + 2
-        IF (J1.GT.J2) GO TO 130
-        IRHS = -IW(J1-2)
-        W1 = RHS(IRHS)
-        IRHS = IW(J1-1)
-        W2 = RHS(IRHS)
-        K1 = APOS
-        K3 = APOS + J2 - J1 + 2
-        DO 120 J = J1,J2
-          IRHS = IABS(IW(J)+0)
-          RHS(IRHS) = RHS(IRHS) + W1*A(K1) + W2*A(K3)
-          K1 = K1 + 1
-          K3 = K3 + 1
-  120   CONTINUE
-  130   APOS = APOS + 2* (J2-J1+1) + 1
-  140 CONTINUE
-  150 LATOP = APOS - 1
-      RETURN
-      END
-      SUBROUTINE MA27RD(N,A,LA,IW,LIW,W,MAXFNT,RHS,IW2,NBLK,LATOP)
-      INTEGER LA,LATOP,LIW,MAXFNT,N,NBLK
-      DOUBLE PRECISION A(LA),RHS(N),W(MAXFNT)
-      INTEGER IW(LIW),IW2(NBLK)
-      DOUBLE PRECISION W1,W2
-      INTEGER APOS,APOS2,I1RHS,I2RHS,IBLK,IFR,IIPIV,IIRHS,ILVL,IPIV,
-     +        IPOS,IRHS,IST,J,J1,J2,JJ,JJ1,JJ2,JPIV,JPOS,K,LIELL,LOOP,
-     +        NPIV
-      INTRINSIC IABS,MIN0
-      COMMON /MA27FD/IOVFLO,NEMIN,IFRLVL(20)
-      INTEGER IOVFLO,NEMIN
-      INTEGER IFRLVL
-      SAVE /MA27FD/
-      APOS = LATOP + 1
-      NPIV = 0
-      IBLK = NBLK + 1
-      DO 180 LOOP = 1,N
-        IF (NPIV.GT.0) GO TO 110
-        IBLK = IBLK - 1
-        IF (IBLK.LT.1) GO TO 190
-        IPOS = IW2(IBLK)
-        LIELL = -IW(IPOS)
-        NPIV = 1
-        IF (LIELL.GT.0) GO TO 10
-        LIELL = -LIELL
-        IPOS = IPOS + 1
-        NPIV = IW(IPOS)
-   10   JPOS = IPOS + NPIV
-        J2 = IPOS + LIELL
-        ILVL = MIN0(10,NPIV) + 10
-        IF (LIELL.LT.IFRLVL(ILVL)) GO TO 110
-        J1 = IPOS + 1
-        IFR = 0
-        DO 20 JJ = J1,J2
-          J = IABS(IW(JJ)+0)
-          IFR = IFR + 1
-          W(IFR) = RHS(J)
-   20   CONTINUE
-        JPIV = 1
-        DO 90 IIPIV = 1,NPIV
-          JPIV = JPIV - 1
-          IF (JPIV.EQ.1) GO TO 90
-          IPIV = NPIV - IIPIV + 1
-          IF (IPIV.EQ.1) GO TO 30
-          IF (IW(JPOS-1).LT.0) GO TO 60
-   30     JPIV = 1
-          APOS = APOS - (LIELL+1-IPIV)
-          IST = IPIV + 1
-          W1 = W(IPIV)*A(APOS)
-          IF (LIELL.LT.IST) GO TO 50
-          JJ1 = APOS + 1
-          DO 40 J = IST,LIELL
-            W1 = W1 + A(JJ1)*W(J)
-            JJ1 = JJ1 + 1
-   40     CONTINUE
-   50     W(IPIV) = W1
-          JPOS = JPOS - 1
-          GO TO 90
-   60     JPIV = 2
-          APOS2 = APOS - (LIELL+1-IPIV)
-          APOS = APOS2 - (LIELL+2-IPIV)
-          IST = IPIV + 1
-          W1 = W(IPIV-1)*A(APOS) + W(IPIV)*A(APOS+1)
-          W2 = W(IPIV-1)*A(APOS+1) + W(IPIV)*A(APOS2)
-          IF (LIELL.LT.IST) GO TO 80
-          JJ1 = APOS + 2
-          JJ2 = APOS2 + 1
-          DO 70 J = IST,LIELL
-            W1 = W1 + W(J)*A(JJ1)
-            W2 = W2 + W(J)*A(JJ2)
-            JJ1 = JJ1 + 1
-            JJ2 = JJ2 + 1
-   70     CONTINUE
-   80     W(IPIV-1) = W1
-          W(IPIV) = W2
-          JPOS = JPOS - 2
-   90   CONTINUE
-        IFR = 0
-        DO 100 JJ = J1,J2
-          J = IABS(IW(JJ)+0)
-          IFR = IFR + 1
-          RHS(J) = W(IFR)
-  100   CONTINUE
-        NPIV = 0
-        GO TO 180
-  110   IF (NPIV.EQ.1) GO TO 120
-        IF (IW(JPOS-1).LT.0) GO TO 150
-  120   NPIV = NPIV - 1
-        APOS = APOS - (J2-JPOS+1)
-        IIRHS = IW(JPOS)
-        W1 = RHS(IIRHS)*A(APOS)
-        J1 = JPOS + 1
-        IF (J1.GT.J2) GO TO 140
-        K = APOS + 1
-        DO 130 J = J1,J2
-          IRHS = IABS(IW(J)+0)
-          W1 = W1 + A(K)*RHS(IRHS)
-          K = K + 1
-  130   CONTINUE
-  140   RHS(IIRHS) = W1
-        JPOS = JPOS - 1
-        GO TO 180
-  150   NPIV = NPIV - 2
-        APOS2 = APOS - (J2-JPOS+1)
-        APOS = APOS2 - (J2-JPOS+2)
-        I1RHS = -IW(JPOS-1)
-        I2RHS = IW(JPOS)
-        W1 = RHS(I1RHS)*A(APOS) + RHS(I2RHS)*A(APOS+1)
-        W2 = RHS(I1RHS)*A(APOS+1) + RHS(I2RHS)*A(APOS2)
-        J1 = JPOS + 1
-        IF (J1.GT.J2) GO TO 170
-        JJ1 = APOS + 2
-        JJ2 = APOS2 + 1
-        DO 160 J = J1,J2
-          IRHS = IABS(IW(J)+0)
-          W1 = W1 + RHS(IRHS)*A(JJ1)
-          W2 = W2 + RHS(IRHS)*A(JJ2)
-          JJ1 = JJ1 + 1
-          JJ2 = JJ2 + 1
-  160   CONTINUE
-  170   RHS(I1RHS) = W1
-        RHS(I2RHS) = W2
-        JPOS = JPOS - 2
-  180 CONTINUE
-  190 RETURN
-      END
diff --git a/deal.II/contrib/hsl/source/ma47.f b/deal.II/contrib/hsl/source/ma47.f
deleted file mode 100644 (file)
index ebe3a41..0000000
+++ /dev/null
@@ -1,5075 +0,0 @@
-C *******************************************************************
-C COPYRIGHT (c) 1993 Rutherford Appleton Laboratory.
-
-C None of the comments in this Copyright notice between the lines
-C of asterisks shall be removed or altered in any way.
-
-C This Package is intended for compilation without modification,
-C so most of the embedded comments have been removed.
-
-C ALL USE IS SUBJECT TO LICENCE. For full details of an HSL ARCHIVE
-C Licence, see http://hsl.rl.ac.uk/archive/cou.html
-
-C Please note that for an HSL ARCHIVE Licence:
-
-C 1. The Package must not be copied for use by any other person.
-C    Supply of any part of the library by the Licensee to a third party
-C    shall be subject to prior written agreement between AEA
-C    Technology plc and the Licensee on suitable terms and conditions,
-C    which will include financial conditions.
-C 2. All information on the Package is provided to the Licensee on the
-C    understanding that the details thereof are confidential.
-C 3. All publications issued by the Licensee that include results obtained
-C    with the help of one or more of the Packages shall acknowledge the
-C    use of the Packages. The Licensee will notify the Numerical Analysis
-C    Group at Rutherford Appleton Laboratory of any such publication.
-C 4. The Packages may be modified by or on behalf of the Licensee
-C    for such use in research applications but at no time shall such
-C    Packages or modifications thereof become the property of the
-C    Licensee. The Licensee shall make available free of charge to the
-C    copyright holder for any purpose all information relating to
-C    any modification.
-C 5. Neither CCLRC nor AEA Technology plc shall be liable for any
-C    direct or consequential loss or damage whatsoever arising out of
-C    the use of Packages by the Licensee.
-C *******************************************************************
-
-C######DATE 24 May 1993
-C 4 Feb 1994. Modified to limit searches for structured pivots under
-C control of ICNTL(4).
-C July 1994. Code added to avoid thrashing when there are no
-C nondefective rows of minimal row count.
-C 7/12/94. Some defaults changed following further testing. Minor
-C     defects (mostly in comments) remedied.
-
-      SUBROUTINE MA47AD(N,NE,IRN,JCN,IW,LIW,KEEP,ICNTL,RINFO,INFO)
-      INTEGER N,NE,IRN(NE),JCN(NE),LIW,IW(LIW),KEEP(NE+5*N+2),ICNTL(7)
-      DOUBLE PRECISION RINFO(4)
-      INTEGER INFO(24)
-      INTRINSIC MIN
-      EXTERNAL MA47GD,MA47HD,MA47JD,MA47KD,MA47LD,MA47MD,MA47ND
-      INTEGER FATHER,I,IPE,COUNT,IWFR,K,LDIAG,LEAF,LP,LW,LROW,MAP,MARK,
-     +        MP,NODE,NODES,NV,PERM,SIZES
-      LP = ICNTL(1)
-      MP = ICNTL(2)
-      LDIAG = ICNTL(3)
-      DO 10 I = 1,14
-        INFO(I) = 0
-   10 CONTINUE
-      IF (LDIAG.GE.3 .AND. MP.GT.0) THEN
-        WRITE (MP,'(//A,I6,A,I7,A,I7)') ' Entering MA47AD with N =',N,
-     +    '  NE =',NE,'  LIW =',LIW
-        WRITE (MP,'(A,6I6)') ' ICNTL(1:6) =', (ICNTL(I),I=1,6)
-        K = MIN(9,NE)
-        IF (LDIAG.EQ.4) K = NE
-        IF (K.GT.0) THEN
-          WRITE (MP,'(A/(3(I6,A,2I6,A)))') ' Matrix entries:',
-     +      (I,': (',IRN(I),JCN(I),')',I=1,K)
-          IF (K.LT.NE) WRITE (MP,'(A)') '     . . .'
-        END IF
-        K = MIN(10,N)
-        IF (LDIAG.EQ.4) K = N
-        IF (ICNTL(4).EQ.1 .AND. K.GT.0) THEN
-          WRITE (MP,'(A,10I6:/(7X,10I6))') ' KEEP =', (KEEP(I),I=1,K)
-          IF (K.LT.N) WRITE (MP,'(7X,A)') '     . . .'
-        END IF
-      END IF
-      IF (N.LT.1 .OR. (N+N+N)/3.NE.N) GO TO 20
-      IF (NE.LT.1) GO TO 30
-      LW = LIW - 4*N - 4
-      IPE = LW + 1
-      COUNT = IPE + N + 1
-      NV = COUNT + N + 1
-      LEAF = NV + N + 1
-      PERM = 1
-      LROW = PERM + N
-      NODE = LROW + N
-      MARK = NODE + N
-      FATHER = MARK + N
-      SIZES = FATHER + N
-      MAP = SIZES + 2
-      IF (ICNTL(4).NE.1) THEN
-        IF (LW.LT.NE*2+N) GO TO 60
-        CALL MA47GD(N,NE,IRN,JCN,IW,IW(IPE),IW(COUNT),IW(NV),KEEP(MARK),
-     +              IWFR,ICNTL,INFO)
-        KEEP(SIZES) = IW(COUNT)
-        CALL MA47HD(N,IW(IPE+1),IW,LW,IWFR,IW(COUNT),IW(NV),
-     +              KEEP(FATHER),KEEP(LROW),KEEP(NODE),KEEP(MARK),
-     +              IW(LEAF),KEEP(PERM),ICNTL,INFO)
-        IF (INFO(1).EQ.-3) GO TO 50
-      ELSE
-        IF (LW.LT.NE+N) GO TO 40
-        CALL MA47JD(N,NE,IRN,JCN,KEEP,IW,IW(IPE),IW(COUNT),IW(NV),
-     +              KEEP(MARK),IWFR,ICNTL,INFO)
-        DO 12 I = 1,N
-          KEEP(FATHER+I-1) = IW(NV+I)
-   12   CONTINUE
-        IF (INFO(1).LT.0) GO TO 80
-        CALL MA47KD(N,IW(IPE+1),IW,LW,IWFR,KEEP,IW(COUNT),KEEP(FATHER),
-     +              KEEP(LROW),IW(NV),KEEP(NODE),KEEP(MARK),IW(LEAF),
-     +              ICNTL,INFO)
-        IF (INFO(1).EQ.-3) GO TO 50
-        IF (INFO(1).LT.0) GO TO 90
-      END IF
-      CALL MA47LD(N,KEEP(FATHER),KEEP(LROW),KEEP(NODE),IW(COUNT),IW(NV),
-     +            IW(LEAF),KEEP(MARK),KEEP(PERM),NODES,ICNTL)
-      KEEP(SIZES) = INFO(3)
-      KEEP(SIZES+1) = NODES
-      CALL MA47ND(N,NE,IRN,JCN,KEEP(MAP),KEEP(LROW),KEEP(PERM),
-     +            IW(COUNT),IW(IPE))
-      DO 15 K = 1,NE
-        IW(KEEP(MAP+K-1)+LIW-NE) = JCN(K)
-   15 CONTINUE
-      CALL MA47MD(N,NE-KEEP(SIZES),IW(NODES+N+2),LIW-NODES-N-1,
-     +            KEEP(LROW),KEEP(PERM),NODES,IW,KEEP(NODE),IW(NODES+1),
-     +            KEEP(FATHER),ICNTL(5),INFO,RINFO)
-      GO TO 100
-   20 INFO(1) = -1
-      IF (LDIAG.GT.0 .AND. LP.GT.0) WRITE (LP,'(A,I3/A,I8)')
-     +    ' **** Error return from MA47AD ****  INFO(1) =',INFO(1),
-     +    ' N has value',N
-      GO TO 100
-   30 INFO(1) = -2
-      IF (LDIAG.GT.0 .AND. LP.GT.0) WRITE (LP,'(A,I3/A,I10)')
-     +    ' **** Error return from MA47AD ****  INFO(1) =',INFO(1),
-     +    ' NE has value',NE
-      GO TO 100
-   40 INFO(2) = NE + 5*N + 4
-      GO TO 70
-   50 INFO(2) = LIW + INFO(2)
-      GO TO 70
-   60 INFO(2) = 2*NE + 5*N + 4
-   70 INFO(1) = -3
-      IF (LDIAG.GT.0 .AND. LP.GT.0) WRITE (LP,'(A,I3/A,I10,A,I10)')
-     +    ' **** Error return from MA47AD ****  INFO(1) =',INFO(1),
-     +    ' LIW is too small. It must be increased from',LIW,
-     +    ' to at least',INFO(2)
-      RETURN
-   80 IF (LDIAG.GT.0 .AND. LP.GT.0) WRITE (LP,'(A,I3/A/I10,A)')
-     +    ' **** Error return from MA47AD ****  INFO(1) =',INFO(1),
-     +    ' Invalid permutation supplied in KEEP. Component',INFO(2),
-     +    ' is faulty.'
-      RETURN
-   90 IF (LDIAG.GT.0 .AND. LP.GT.0) WRITE (LP,'(A,I3/A/I10,A)')
-     +    ' **** Error return from MA47AD ****  INFO(1) =',INFO(1),
-     +    ' Invalid pivot sequence supplied in KEEP. Component',INFO(2),
-     +    ' is negative but the next component is not negative.'
-      RETURN
-  100 IF (LDIAG.GE.3 .AND. MP.GT.0) THEN
-        WRITE (MP,'(/A,I7,A,2F7.0/A,5I8/(14X,5(I8)))')
-     +    ' Leaving MA47AD with  INFO(1) =',INFO(1),'  RINFO(1:2) =',
-     +    RINFO(1),RINFO(2),' INFO(2:14) = ', (INFO(I),I=2,14)
-        IF (INFO(1).GE.0) THEN
-          K = MIN(10,NE)
-          IF (LDIAG.EQ.4) K = NE
-          WRITE (MP,'(A/(10I6))') ' Column indices:', (JCN(K),K=1,K)
-          IF (K.LT.NE) WRITE (MP,'(A)') '     . . .'
-          K = MIN(9,N)
-          IF (LDIAG.EQ.4) K = N
-          WRITE (MP,9000) ' KEEP(1:',N,') =',' (Permutation)',
-     +      (KEEP(I),I=1,K)
-          IF (K.LT.N) WRITE (MP,'(16X,A)') ' . . .'
- 9000     FORMAT (A,I7,A/A/ (12X,10I6))
-          WRITE (MP,9000) ' KEEP(N+1:N+',N,') =',
-     +      ' (No. of entries in permuted rows)', (KEEP(I),I=N+1,N+K)
-          IF (K.LT.N) WRITE (MP,'(16X,A)') ' . . .'
-          WRITE (MP,9000) ' KEEP(2N+1:2N+',N,') =',
-     +      ' (Tree nodes at which variables eliminated)',
-     +      (KEEP(I),I=2*N+1,2*N+K)
-          IF (K.LT.N) WRITE (MP,'(16X,A)') ' . . .'
-          K = MIN(10,KEEP(5*N+2))
-          WRITE (MP,9000) ' KEEP(3N+1:3N+',KEEP(5*N+2),') =',
-     +      ' (Markowitz costs at tree nodes)', (KEEP(I),I=3*N+1,3*N+K)
-          IF (K.LT.KEEP(5*N+2)) WRITE (MP,'(16X,A)') ' . . .'
-          WRITE (MP,9000) ' KEEP(4N+1:4N+',KEEP(5*N+2),') =',
-     +      ' (Fathers of nodes in tree)', (KEEP(I),I=4*N+1,4*N+K)
-          IF (K.LT.KEEP(5*N+2)) WRITE (MP,'(16X,A)') ' . . .'
-          WRITE (MP,9010) ' KEEP(5N+1:5N+2) =',
-     +      ' (Nos. of faulty entries and tree nodes)',KEEP(5*N+1),
-     +      KEEP(5*N+2)
- 9010     FORMAT (A/A/ (12X,2I6))
-          K = MIN(10,NE)
-          IF (LDIAG.EQ.4) K = NE
-          WRITE (MP,9000) ' KEEP(5N+3:5N+2+',NE,') =',' (Map array)',
-     +      (KEEP(I),I=5*N+3,5*N+2+K)
-          IF (K.LT.NE) WRITE (MP,'(16X,A)') ' . . .'
-        END IF
-      END IF
-      END
-      SUBROUTINE MA47BD(N,NE,JCN,A,LA,IW,LIW,KEEP,CNTL,ICNTL,IW1,RINFO,
-     +                  INFO)
-      INTEGER N,NE,JCN(NE),LA,ICNTL(7)
-      DOUBLE PRECISION A(LA),CNTL(2),RINFO(4)
-      INTEGER LIW,IW(LIW),KEEP(NE+5*N+2),IW1(2*N+2),INFO(24)
-      INTRINSIC MIN
-      EXTERNAL MA47OD,MA47UD
-      INTEGER FATHER,I,K,KE,LDIAG,LP,LROW,MAP,MARK,MP,NODE,PERM,SIZES
-      LP = ICNTL(1)
-      MP = ICNTL(2)
-      LDIAG = ICNTL(3)
-      IF (N.LT.1) GO TO 30
-      IF ((N+N+N)/3.NE.N) GO TO 30
-      IF (NE.LT.1) GO TO 40
-      IF (LIW.LT.NE*2) GO TO 50
-      IF (LA.LT.NE*2) GO TO 70
-      INFO(1) = 0
-      INFO(2) = 0
-      DO 10 I = 15,24
-        INFO(I) = 0
-   10 CONTINUE
-      IF (LDIAG.GT.2 .AND. MP.GT.0) THEN
-        WRITE (MP,'(//A,I6,3(A,I7)/A,3I7/A,I7/A,1P2D12.4)')
-     +    ' Entering MA47BD with N =',N,'  NE =',NE,'  LA =',LA,
-     +    '  LIW =',LIW,' ICNTL(1:3)  =', (ICNTL(I),I=1,3),
-     +    ' ICNTL(5)    =',ICNTL(5),' CNTL(1:2)   =',CNTL(1),CNTL(2)
-        KE = MIN(6,NE)
-        IF (LDIAG.EQ.4) KE = NE
-        IF (KE.GT.0) THEN
-          WRITE (MP,'(A/( 3(I6,'':'',1PD12.4) ) )')
-     +      ' Matrix entries:', (K,A(K),K=1,KE)
-          IF (K.LT.NE) WRITE (MP,'(A)') '     . . .'
-          WRITE (MP,'(A/(10I6))') ' Column indices:', (JCN(K),K=1,KE)
-          IF (K.LT.NE) WRITE (MP,'(A)') '     . . .'
-        END IF
-        K = MIN(10,N)
-        IF (LDIAG.EQ.4) K = N
-        WRITE (MP,9000) ' KEEP(1:',N,') =',' (Permutation)',
-     +    (KEEP(I),I=1,K)
-        IF (K.LT.N) WRITE (MP,'(16X,A)') ' . . .'
- 9000   FORMAT (A,I7,A/A/ (12X,10I6))
-        WRITE (MP,9000) ' KEEP(N+1:N+',N,') =',
-     +    ' (No. of entries in permuted rows)', (KEEP(I),I=N+1,N+K)
-        IF (K.LT.N) WRITE (MP,'(16X,A)') ' . . .'
-        WRITE (MP,9000) ' KEEP(2N+1:2N+',N,') =',
-     +    ' (Tree nodes at which variables eliminated)',
-     +    (KEEP(I),I=2*N+1,2*N+K)
-        K = MIN(K,KEEP(5*N+2))
-        IF (K.LT.KEEP(5*N+2)) WRITE (MP,'(16X,A)') ' . . .'
-        WRITE (MP,9000) ' KEEP(3N+1:3N+',KEEP(5*N+2),') =',
-     +    ' (Markowitz costs at tree nodes)', (KEEP(I),I=3*N+1,3*N+K)
-        IF (K.LT.KEEP(5*N+2)) WRITE (MP,'(16X,A)') ' . . .'
-        WRITE (MP,9000) ' KEEP(4N+1:4N+',KEEP(5*N+2),') =',
-     +    ' (Fathers of nodes in tree)', (KEEP(I),I=4*N+1,4*N+K)
-        IF (K.LT.KEEP(5*N+2)) WRITE (MP,'(16X,A)') ' . . .'
-        WRITE (MP,9010) ' KEEP(5N+1:5N+2) =',
-     +    ' (Nos. of faulty entries and tree nodes)',KEEP(5*N+1),
-     +    KEEP(5*N+2)
- 9010   FORMAT (A/A/ (12X,2I6))
-        WRITE (MP,9000) ' KEEP(5N+3:5N+2+',NE,') =',' (Map array)',
-     +    (KEEP(I),I=5*N+3,5*N+2+KE)
-        IF (KE.LT.NE) WRITE (MP,'(16X,A)') ' . . .'
-      END IF
-      PERM = 1
-      LROW = PERM + N
-      NODE = LROW + N
-      MARK = NODE + N
-      FATHER = MARK + N
-      SIZES = FATHER + N
-      MAP = SIZES + 2
-CDIR@ IVDEP
-      DO 20 K = 1,NE
-        A(KEEP(MAP+K-1)+LA-NE) = A(K)
-        IW(KEEP(MAP+K-1)+LIW-NE) = JCN(K)
-   20 CONTINUE
-      CALL MA47OD(N,NE-KEEP(SIZES),A,LA,IW,LIW,KEEP(LROW),KEEP(PERM),
-     +            KEEP(SIZES+1),IW1,KEEP(MARK),KEEP(NODE),IW1(N+1),
-     +            KEEP(FATHER),CNTL,ICNTL(5),INFO,RINFO)
-      IF (INFO(1).EQ.-3) GO TO 60
-      IF (INFO(1).EQ.-4) GO TO 80
-      GO TO 90
-   30 INFO(1) = -1
-      IF (LP.GT.0 .AND. LDIAG.GT.0) WRITE (LP,9020) INFO(1)
- 9020 FORMAT (' **** Error return from MA47BD ****  INFO(1)=',I3)
-      IF (LP.GT.0 .AND. LDIAG.GT.0)
-     +    WRITE (LP,'(A,I10)') ' N has value',N
-      GO TO 100
-   40 INFO(1) = -2
-      IF (LP.GT.0 .AND. LDIAG.GT.0) WRITE (LP,9020) INFO(1)
-      IF (LP.GT.0 .AND. LDIAG.GT.0) WRITE (LP,
-     +    '(A,I10)') ' NE has value',NE
-      GO TO 100
-   50 INFO(1) = -3
-      INFO(2) = NE*2
-   60 IF (LP.GT.0 .AND. LDIAG.GT.0) WRITE (LP,9020) INFO(1)
-      IF (LP.GT.0 .AND. LDIAG.GT.0) WRITE (LP,'(A,I10,A,I10)')
-     +    ' LIW is too small. It must be increased from',LIW,
-     +    ' to at least',INFO(2)
-      GO TO 100
-   70 INFO(1) = -4
-      INFO(2) = NE*2
-   80 IF (LP.GT.0 .AND. LDIAG.GT.0) WRITE (LP,9020) INFO(1)
-      IF (LP.GT.0 .AND. LDIAG.GT.0) WRITE (LP,'(A,I10,A,I10)')
-     +    ' LA is too small. It must be increased from',LA,
-     +    ' to at least',INFO(2)
-      GO TO 100
-   90 IF (LDIAG.GT.2 .AND. MP.GT.0) THEN
-        WRITE (MP,'(/A,I7,A,I7/A,2F9.0/A,2I8/A,5I8/(15X,5I8))')
-     +    ' Leaving MA47BD with  INFO(1) =',INFO(1),'  IERROR =',
-     +    INFO(2),' RINFO(3:4)  = ',RINFO(3),RINFO(4),' INFO(6:7)   = ',
-     +     (INFO(I),I=6,7),' INFO(15:24) = ', (INFO(I),I=15,24)
-        CALL MA47UD(A,LA,IW,LIW,ICNTL)
-      END IF
-  100 RETURN
-      END
-      SUBROUTINE MA47CD(N,A,LA,IW,LIW,W,RHS,IW1,ICNTL)
-      INTEGER N,LA
-      DOUBLE PRECISION A(LA)
-      INTEGER LIW,IW(LIW)
-      DOUBLE PRECISION W(N),RHS(N)
-      INTEGER IW1(N),ICNTL(7)
-      INTRINSIC MIN
-      EXTERNAL MA47QD,MA47RD,MA47UD
-      DOUBLE PRECISION ZERO
-      PARAMETER (ZERO=0.0D0)
-      INTEGER I,K,LDIAG,MP
-      MP = ICNTL(2)
-      LDIAG = ICNTL(3)
-      IF (LDIAG.GE.3 .AND. MP.GT.0) THEN
-        WRITE (MP,'(//A,I6,3(A,I7))') ' Entering MA47CD with N =',N,
-     +    '  LA =',LA,'  LIW =',LIW
-        CALL MA47UD(A,LA,IW,LIW,ICNTL)
-        K = MIN(10,N)
-        IF (LDIAG.EQ.4) K = N
-        WRITE (MP,'(A, 1P,5D13.3/(4X, 1P,5D13.3))') ' RHS',
-     +    (RHS(I),I=1,K)
-        IF (K.LT.N) WRITE (MP,'(A)') '     . . .'
-      END IF
-      IF (IW(2).EQ.0) THEN
-      ELSE
-        CALL MA47QD(N,A,LA,IW,LIW,W,RHS,IW1,ICNTL)
-        CALL MA47RD(N,A,LA,IW,LIW,W,RHS,IW1,ICNTL)
-      END IF
-      IF (LDIAG.GE.3 .AND. MP.GT.0) THEN
-        WRITE (MP,'(//A)') ' Leaving MA47CD with RHS:'
-        WRITE (MP,'(1P,5D13.3)') (RHS(I),I=1,K)
-        IF (K.LT.N) WRITE (MP,'(A)') '     . . .'
-      END IF
-      END
-      SUBROUTINE MA47FD(N,IPE,FLAG,IW,LW,IWFR,NCMPA)
-      INTEGER N,IPE(N),FLAG(N),LW,IW(LW),IWFR,NCMPA
-      INTEGER I,IR,K,L,LEN1,LEN2,LEN3,LWFR
-      NCMPA = NCMPA + 1
-      DO 10 I = 1,N
-        L = IPE(I)
-        IF (L.LE.0 .OR. FLAG(I).EQ.-1) GO TO 10
-        IPE(I) = IW(L)
-        IW(L) = -I
-   10 CONTINUE
-      IWFR = 1
-      LWFR = 1
-      DO 80 IR = 1,N
-        DO 20 K = LWFR,LW
-          IF (IW(K).LT.0) GO TO 30
-   20   CONTINUE
-        GO TO 90
-   30   I = -IW(K)
-        IW(IWFR) = IPE(I)
-        IPE(I) = IWFR
-        IWFR = IWFR + 1
-        IF (FLAG(I).LE.-2) THEN
-          L = IWFR - 1
-          LEN1 = IW(K+1)
-          IW(L+1) = LEN1
-          LEN3 = IW(K+2)
-          IW(L+2) = LEN3
-          LEN2 = IW(L) - LEN1 - LEN3 - 2
-          IWFR = L + 3
-          DO 40 LWFR = K + 3,K + 2 + LEN1
-            IF (FLAG(IW(LWFR)).LT.0) THEN
-              IW(L+1) = IW(L+1) - 1
-              IW(L) = IW(L) - 1
-            ELSE
-              IW(IWFR) = IW(LWFR)
-              IWFR = IWFR + 1
-            END IF
-   40     CONTINUE
-          K = LWFR
-          DO 50 LWFR = K,K - 1 + LEN2
-            IF (FLAG(IW(LWFR)).LT.0) THEN
-              IW(L) = IW(L) - 1
-            ELSE
-              IW(IWFR) = IW(LWFR)
-              IWFR = IWFR + 1
-            END IF
-   50     CONTINUE
-          K = LWFR
-          DO 60 LWFR = K,K - 1 + LEN3
-            IF (FLAG(IW(LWFR)).LT.0) THEN
-              IW(L+2) = IW(L+2) - 1
-              IW(L) = IW(L) - 1
-            ELSE
-              IW(IWFR) = IW(LWFR)
-              IWFR = IWFR + 1
-            END IF
-   60     CONTINUE
-        ELSE
-          DO 70 LWFR = K + 1,K + IW(IWFR-1)
-            IW(IWFR) = IW(LWFR)
-            IWFR = IWFR + 1
-   70     CONTINUE
-        END IF
-   80 CONTINUE
-   90 CONTINUE
-      END
-      SUBROUTINE MA47GD(N,NE,IRN,JCN,IW,IPE,COUNT,NV,FLAG,IWFR,ICNTL,
-     +                  INFO)
-      INTEGER N,NE,IRN(NE),JCN(NE),IW(NE*2+N),IPE(0:N),COUNT(0:N),NV(N),
-     +        FLAG(N),IWFR,ICNTL(3),INFO(4)
-      INTRINSIC MAX,MIN
-      INTEGER I,J,K,L,LDIAG,MP
-      MP = ICNTL(2)
-      LDIAG = ICNTL(3)
-      IF (MP.LE.0) LDIAG = 0
-      INFO(1) = 0
-      COUNT(0) = 0
-      DO 10 I = 1,N
-        FLAG(I) = 0
-        COUNT(I) = 0
-        NV(I) = -1
-   10 CONTINUE
-      DO 20 K = 1,NE
-        I = IRN(K)
-        J = JCN(K)
-        IF (MIN(I,J).LT.1 .OR. MAX(I,J).GT.N) THEN
-          IRN(K) = 0
-          JCN(K) = 0
-          COUNT(0) = COUNT(0) + 1
-          INFO(1) = 1
-          IF (COUNT(0).LE.1 .AND. LDIAG.GT.1) WRITE (MP,'(2A,I2)')
-     +        ' *** Warning message from subroutine MA47AD ***',
-     +        '  INFO(1) =',INFO(1)
-          IF (COUNT(0).LE.10 .AND. LDIAG.GT.1) WRITE (MP,'(3(I6,A))') K,
-     +        'th entry (in row',I,' and column',J,') ignored'
-        ELSE IF (I.NE.J) THEN
-          COUNT(I) = COUNT(I) + 1
-          COUNT(J) = COUNT(J) + 1
-        ELSE
-          COUNT(I) = COUNT(I) + 1
-          NV(I) = 1
-        END IF
-   20 CONTINUE
-      IPE(0) = COUNT(0)
-      DO 30 I = 1,N
-        IPE(I) = IPE(I-1) + COUNT(I) + 1
-   30 CONTINUE
-      DO 40 K = 1,NE
-        I = IRN(K)
-        J = JCN(K)
-        IW(IPE(I)) = J
-        IPE(I) = IPE(I) - 1
-        IF (I.NE.J) THEN
-          IW(IPE(J)) = I
-          IPE(J) = IPE(J) - 1
-        END IF
-   40 CONTINUE
-      INFO(3) = COUNT(0)
-      INFO(4) = 0
-      IWFR = 1
-      DO 60 I = 1,N
-        L = IPE(I)
-        IPE(I) = IWFR
-        DO 50 K = L + 1,L + COUNT(I)
-          J = IW(K)
-          IF (FLAG(J).NE.I) THEN
-            FLAG(J) = I
-            IWFR = IWFR + 1
-            IW(IWFR) = J
-          ELSE
-            IF (I.LE.J) INFO(4) = INFO(4) + 1
-          END IF
-   50   CONTINUE
-        IW(IPE(I)) = IWFR - IPE(I)
-        IWFR = IWFR + 1
-   60 CONTINUE
-      IF (INFO(4).GT.0) THEN
-        INFO(1) = INFO(1) + 2
-        IF (LDIAG.GT.1) WRITE (MP,'(A/I6,A)')
-     +      ' *** Warning message from subroutine MA47AD ***',INFO(4),
-     +      ' duplicate entries found.'
-      END IF
-      END
-      SUBROUTINE MA47HD(N,IPE,IW,LW,IWFR,COUNT,NV,NEXT,LAST,IPR,FLAG,
-     +                  LEAF,SVARS,ICNTL,INFO)
-      INTEGER N,IPE(N),LW,IW(LW),IWFR,COUNT(N),NV(N),NEXT(N),LAST(N),
-     +        IPR(N),FLAG(N),LEAF(N),SVARS(N),ICNTL(7),INFO(24)
-      INTRINSIC ABS,MAX,MIN,REAL
-      EXTERNAL MA47FD,MA47TD,MA47VD,MA47ZD
-      DOUBLE PRECISION ZERO
-      PARAMETER (ZERO=0D0)
-      LOGICAL BOUND
-      DOUBLE PRECISION CMIN,COST
-      INTEGER FLG,FLG1,I,IE,IEL,IP,IR,IRL,IS,ITHR,JP,JP1,JP2,JP3,JP4,JS,
-     +        K,KE,KIND,KP,KP1,KP2,KS,K1,K2,LDIAG,LIST,LOOP,LS,ME,MINF,
-     +        MINR,ML,MP,MROWS,MS,NCMP,NEL,NFLG,NP,NP0,NR(3),NROWS,NS,
-     +        NSC(3),NSVARS,NVC,NVPIV,PART,PIV(2),PIVOT(2),PIVT,RANK
-      INTEGER SHIFT,THRESH
-      MP = ICNTL(2)
-      LDIAG = ICNTL(3)
-      IF (MP.LE.0) LDIAG = 0
-      MROWS = N
-      IF (ICNTL(4).GT.1)MROWS = ICNTL(4)
-      CALL MA47TD(N,IPE,IW,LW,NV,NEXT,LAST,LEAF,FLAG,COUNT,SVARS)
-      IF (LDIAG.GT.4) THEN
-        WRITE (MP,'(/A)') '    Row   NV   List'
-        DO 10 I = 1,N
-          KP = IPE(I)
-          IF (KP.EQ.0) THEN
-            WRITE (MP,'(I7,I5)') I,NV(I)
-          ELSE
-            WRITE (MP,'(I7,I5,10I6:/ (12X,10I6))') I,NV(I),
-     +        (IW(K),K=KP+1,KP+IW(KP))
-          END IF
-   10   CONTINUE
-      END IF
-      THRESH = MAX(SQRT(REAL(N)),3.)
-      RANK = N
-      MINF = 1
-      MINR = 1
-      NCMP = 0
-      NFLG = N*3
-      NEL = 0
-      DO 20 IS = 1,N
-        IPR(IS) = 0
-        FLAG(IS) = NFLG
-   20 CONTINUE
-      DO 30 IS = 1,N
-        K = IPE(IS)
-        IF (K.EQ.0) THEN
-          FLAG(IS) = -1
-        ELSE
-          IR = IW(K)
-          IF (IR.EQ.0) THEN
-            RANK = RANK + NV(IS)
-            NV(IS) = -NV(IS)
-            IR = 1
-          END IF
-          COUNT(IS) = IR
-          NS = IPR(IR)
-          IF (NS.GT.0) LAST(NS) = IS
-          NEXT(IS) = NS
-          IPR(IR) = IS
-          LAST(IS) = 0
-        END IF
-   30 CONTINUE
-      DO 670 ML = 1,N
-        IF (NEL.GE.N) GO TO 680
-        IR = MINR
-        DO 40 MINR = IR,N
-          IF (IPR(MINR).NE.0) GO TO 50
-   40   CONTINUE
-   50   DO 170 ITHR = 1,N
-          NROWS = 0
-          CMIN = REAL(N)**2
-          DO 140 IR = MINR,N
-            IF (MINF.GT.IR) GO TO 70
-            MS = IPR(IR)
-            DO 60 LIST = 1,N
-              IF (MS.EQ.0) THEN
-                 MINF = IR + 1
-                 GO TO 70
-              END IF
-              IF (NV(MS).GT.0) THEN
-                IF (IR.LE.THRESH) GO TO 180
-                GO TO 160
-              END IF
-              MS = NEXT(MS)
-   60       CONTINUE
-   70       MS = IPR(IR)
-            DO 120 LIST = 1,N
-              IF (MS.EQ.0) GO TO 130
-              IF (NFLG.LE.4) CALL MA47ZD(N,FLAG,NFLG)
-              NROWS = NROWS + 1
-              NFLG = NFLG - 1
-              KP = IPE(MS)
-              KP1 = KP + 1
-              KP2 = KP + IW(KP)
-              DO 100 KP = KP1,KP2
-                PART = (IW(KP)-1)/N
-                KE = IW(KP) - PART*N
-                IF (FLAG(KE).EQ.-1) GO TO 100
-                IF (FLAG(KE).LE.-2) THEN
-                  JP = IPE(KE)
-                  IF (PART.EQ.2) THEN
-                    JP1 = JP + 3 + IW(JP+1)
-                    JP2 = JP + IW(JP)
-                  ELSE
-                    JP1 = JP + 3
-                    JP2 = JP + IW(JP) - IW(JP+2)
-                  END IF
-                ELSE
-                  JP1 = KP
-                  JP2 = KP2
-                END IF
-                DO 90 JP = JP1,JP2
-                  IS = IW(JP)
-                  IF (FLAG(IS).GT.NFLG) THEN
-                    FLAG(IS) = NFLG
-                    IF (NV(IS).LT.0) THEN
-                      COST = REAL(COUNT(IS)-1)*REAL(IR-1)
-                    ELSE
-                      COST = REAL(IR+COUNT(IS)-3)*REAL(IR-1)
-                    END IF
-                    IF (COST.LT.CMIN) THEN
-                      CMIN = COST
-                      PIVOT(1) = IS
-                      PIVOT(2) = MS
-                      IF (CMIN.LE.REAL(IR-1)**2) GO TO 150
-                    END IF
-                  END IF
-   90           CONTINUE
-                IF (JP2.EQ.KP2) GO TO 110
-  100         CONTINUE
-  110         IF (NROWS.GE.MROWS) GO TO 150
-              MS = NEXT(MS)
-  120       CONTINUE
-  130       IF (CMIN.LE.REAL(IR)**2) GO TO 150
-  140     CONTINUE
-  150     IR = MAX(COUNT(PIVOT(1)),COUNT(PIVOT(2)))
-          IF (IR.LE.THRESH) GO TO 190
-  160     CALL MA47VD(THRESH,IR+N/10,N,IPE,IW,LW,COUNT,NV,NEXT,LAST,IPR,
-     +                FLAG,NFLG)
-  170   CONTINUE
-  180   KIND = 1
-        ME = MS
-        PIVOT(1) = MS
-        PIVOT(2) = MS
-        PIVT = 0
-        NVPIV = NV(MS)
-        CMIN = REAL(IR-1)**2
-        FLAG(MS) = -1
-        IF (LDIAG.GT.4) WRITE (MP,'(A,I5,A,2I5,A,I5,A,F7.0)')
-     +      ' Pivot',NEL,':',PIVOT(1),NV(PIVOT(1)),' Row count:',
-     +      COUNT(PIVOT(1)),' M-cost=',CMIN
-        NEL = NEL + NVPIV
-        GO TO 210
-  190   KIND = 2
-        IF (NV(PIVOT(1)).LT.0) KIND = 3
-        FLAG(PIVOT(1)) = -1
-        FLAG(PIVOT(2)) = -1
-        PIV(1) = PIVOT(1)
-        PIV(2) = PIVOT(2)
-        NVPIV = ABS(NV(PIVOT(1)))
-        IF (NVPIV.EQ.ABS(NV(PIVOT(2)))) THEN
-          PIVT = 0
-        ELSE
-          IF (NVPIV.GT.ABS(NV(PIVOT(2)))) THEN
-            PIVT = PIVOT(1)
-            NVPIV = ABS(NV(PIVOT(2)))
-          ELSE
-            PIVT = PIVOT(2)
-          END IF
-          MS = LEAF(PIVT)
-          DO 200 K = 2,NVPIV
-            MS = -NEXT(MS)
-  200     CONTINUE
-          LEAF(MS) = LEAF(PIVT)
-          LEAF(PIVT) = -NEXT(MS)
-          FLAG(PIVT) = NFLG
-          NEXT(MS) = 0
-          NV(PIVT) = SIGN(ABS(NV(PIVT))-NVPIV,NV(PIVT))
-          NV(MS) = SIGN(NVPIV,NV(PIVT))
-          COUNT(MS) = COUNT(PIVT)
-          IF (PIVT.EQ.PIVOT(1)) THEN
-            PIV(1) = MS
-          ELSE
-            PIV(2) = MS
-          END IF
-        END IF
-        ME = PIV(1)
-        IF (LDIAG.GT.4) WRITE (*,'(A,I5,A,3I5,A,2I5,A,F7.0)')
-     +      ' Pivot',NEL,':',PIV(1),PIV(2),NV(ME),' Row counts:',
-     +      COUNT(PIVOT(1)),COUNT(PIVOT(2)),' M-cost=',CMIN
-        NSC(2) = 0
-        NVC = 0
-        NEL = NEL + NVPIV*2
-  210   NSVARS = 0
-        IR = 0
-        DO 280 LOOP = MIN(KIND,2),1,-1
-          MS = PIVOT(LOOP)
-          NSC(1) = NSVARS
-          NR(1) = IR
-          IF (MS.NE.PIVT) THEN
-            NS = NEXT(MS)
-            LS = LAST(MS)
-            NEXT(MS) = 0
-            IF (NS.GT.0) LAST(NS) = LS
-            IF (LS.GT.0) THEN
-              NEXT(LS) = NS
-            ELSE
-              IPR(COUNT(MS)) = NS
-            END IF
-          END IF
-          KP = IPE(MS)
-          KP1 = KP + 1
-          KP2 = KP + IW(KP)
-          DO 270 KP = KP1,KP2
-            PART = (IW(KP)-1)/N
-            KE = IW(KP) - PART*N
-            IF (FLAG(KE).EQ.-1) GO TO 270
-            IF (FLAG(KE).LE.-2) THEN
-              IE = KE
-              DO 220 LIST = 1,N
-                IF (NEXT(IE).EQ.0) GO TO 230
-                IEL = IE
-                IE = -LAST(IE)
-                IF (IE.EQ.ME) GO TO 240
-                LAST(IEL) = -ME
-  220         CONTINUE
-  230         NEXT(IE) = -ME
-              LAST(IE) = -ME
-  240         JP = IPE(KE)
-              JP1 = JP + 3
-              JP2 = JP + IW(JP)
-              IF (PART.EQ.0) THEN
-              ELSE IF (PART.EQ.2) THEN
-                JP1 = JP1 + IW(JP+1)
-              ELSE
-                JP2 = JP2 - IW(JP+2)
-              END IF
-            ELSE
-              JP1 = KP
-              JP2 = KP2
-            END IF
-            DO 250 JP = JP1,JP2
-              IS = IW(JP)
-              IF (FLAG(IS).LE.LOOP) THEN
-              ELSE IF (FLAG(IS).EQ.2) THEN
-                NVC = NVC + ABS(NV(IS))
-                NSC(2) = NSC(2) + 1
-                FLAG(IS) = 0
-                COUNT(IS) = COUNT(IS) - NVPIV
-              ELSE
-                IR = IR + ABS(NV(IS))
-                FLAG(IS) = LOOP
-                NSVARS = NSVARS + 1
-                SVARS(NSVARS) = IS
-                LS = LAST(IS)
-                LAST(IS) = 0
-                NS = NEXT(IS)
-                NEXT(IS) = 0
-                IF (NS.GT.0) LAST(NS) = LS
-                IF (LS.GT.0) THEN
-                  NEXT(LS) = NS
-                ELSE
-                  IPR(COUNT(IS)) = NS
-                END IF
-                COUNT(IS) = COUNT(IS) - NVPIV
-              END IF
-  250       CONTINUE
-            IF (JP2.NE.KP2 .AND. LOOP.EQ.1) THEN
-              IF (KIND.EQ.1) THEN
-                IF (PART.EQ.0) FLAG(KE) = -1
-              ELSE
-                DO 260 JP = JP1,JP2
-                  IF (IW(JP).EQ.PIVOT(2)) THEN
-                    FLAG(KE) = -1
-                    GO TO 270
-                  END IF
-  260           CONTINUE
-              END IF
-            END IF
-  270     CONTINUE
-  280   CONTINUE
-        IF (KIND.EQ.1) THEN
-          NSC(2) = NSVARS
-          NR(1) = IR
-          NSC(3) = 0
-          NR(3) = 0
-        ELSE
-          NEXT(PIV(2)) = -ME
-          LAST(PIV(2)) = -ME
-          COUNT(PIV(2)) = -COUNT(PIV(2))
-          IF (KIND.EQ.2) THEN
-            NSC(3) = NSVARS - NSC(1)
-            NR(3) = IR - NR(1)
-            NSC(2) = NSC(1)
-            NR(2) = NR(1)
-            NSC(1) = 0
-            NR(1) = IR
-          ELSE
-            NSC(3) = NSVARS - NSC(1)
-            NR(3) = IR - NR(1) + NVC
-            NSC(1) = NSC(1) - NSC(2)
-            NR(2) = NR(1)
-            NR(1) = IR
-            K1 = 1
-            DO 310 K = 1,NSC(1) + NSC(2)
-              IF (FLAG(SVARS(K)).EQ.2) THEN
-                KS = SVARS(K)
-                SVARS(K) = SVARS(K1)
-                SVARS(K1) = KS
-                K1 = K1 + 1
-              END IF
-  310       CONTINUE
-          END IF
-        END IF
-        IF (NSVARS.EQ.0) THEN
-          IPE(ME) = 0
-          GO TO 670
-        END IF
-        IF (NFLG.LE.4) CALL MA47ZD(N,FLAG,NFLG)
-        NFLG = NFLG - 1
-        DO 450 K = 1,NSVARS
-          IS = SVARS(K)
-          KP = IPE(IS)
-          KP1 = KP + 1
-          KP2 = IW(KP) + KP
-          DO 440 KP = KP1,KP2
-            PART = (IW(KP)-1)/N
-            KE = IW(KP) - N*PART
-            IF (FLAG(KE).GE.0) GO TO 450
-            IF (FLAG(KE).EQ.-1) GO TO 440
-            IF (FLAG(KE).EQ.-NFLG) GO TO 440
-            FLAG(KE) = -NFLG
-            JP = IPE(KE)
-            JP1 = JP + 3
-            JP2 = JP1 + IW(JP+1)
-            JP4 = JP + IW(JP)
-            JP3 = JP4 - IW(JP+2)
-            IF (KIND.EQ.1) THEN
-              DO 340 JP = JP1,JP4
-                IF (FLAG(IW(JP)).GT.2) GO TO 440
-  340         CONTINUE
-            ELSE IF (KIND.EQ.2) THEN
-              DO 350 JP = JP2,JP3
-                IF (FLAG(IW(JP)).GT.2) GO TO 440
-                IF (FLAG(IW(JP)).EQ.1) GO TO 440
-  350         CONTINUE
-              FLG1 = 0
-              DO 360 JP = JP3 + 1,JP4
-                FLG = FLAG(IW(JP))
-                IF (FLG.GT.2) GO TO 440
-                IF (FLG.LE.0) GO TO 360
-                FLG1 = FLG
-  360         CONTINUE
-              DO 370 JP = JP1,JP2 - 1
-                FLG = FLAG(IW(JP))
-                IF (FLG.GT.2) GO TO 440
-                IF (FLG.LE.0) GO TO 370
-                IF (FLG1.NE.0) GO TO 440
-  370         CONTINUE
-            ELSE
-              DO 380 JP = JP2,JP3
-                IF (FLAG(IW(JP)).GT.0) GO TO 440
-  380         CONTINUE
-              FLG1 = 0
-              DO 390 JP = JP3 + 1,JP4
-                FLG = FLAG(IW(JP))
-                IF (FLG.GT.2) GO TO 440
-                IF (FLG.LE.0) GO TO 390
-                IF (FLG1.EQ.0) FLG1 = FLG
-                IF (FLG.NE.FLG1) GO TO 440
-  390         CONTINUE
-              FLG1 = 3 - FLG1
-              DO 400 JP = JP1,JP2 - 1
-                FLG = FLAG(IW(JP))
-                IF (FLG.GT.2) GO TO 440
-                IF (FLG.LE.0) GO TO 400
-                IF (FLG1.EQ.3) FLG1 = FLG
-                IF (FLG.NE.FLG1) GO TO 440
-  400         CONTINUE
-            END IF
-            FLAG(KE) = -1
-            IE = KE
-            DO 420 LIST = 1,N
-              IF (NEXT(IE).EQ.0) GO TO 430
-              IEL = IE
-              IE = -LAST(IE)
-              IF (IE.EQ.ME) GO TO 440
-              LAST(IEL) = -ME
-  420       CONTINUE
-  430       NEXT(IE) = -ME
-            LAST(IE) = -ME
-  440     CONTINUE
-  450   CONTINUE
-        DO 630 LOOP = 1,KIND
-          IF (LOOP.EQ.1) THEN
-            K1 = 1 + NSC(1)
-            K2 = K1 + NSC(2) - 1
-          ELSE IF (LOOP.EQ.2) THEN
-            K1 = K2 + 1
-            K2 = NSVARS
-            DO 460 K = K1,K2
-              IS = SVARS(K)
-              IF (NV(IS).NE.0) FLAG(IS) = NFLG
-  460       CONTINUE
-          ELSE
-            DO 470 K = K1,K2
-              IS = SVARS(K)
-              IF (NV(IS).NE.0) FLAG(IS) = 1
-  470       CONTINUE
-            K1 = 1
-            K2 = NSC(1)
-            DO 480 K = K1,K2
-              IS = SVARS(K)
-              IF (NV(IS).NE.0) FLAG(IS) = NFLG
-  480       CONTINUE
-          END IF
-          DO 620 K = K1,K2
-            IS = SVARS(K)
-            BOUND = COUNT(IS) .GT. THRESH
-            IF (LOOP.EQ.1) NV(IS) = ABS(NV(IS))
-            IF (NFLG.LE.4) CALL MA47ZD(N,FLAG,NFLG)
-            NFLG = NFLG - 1
-            IR = NR(LOOP)
-            KP = IPE(IS)
-            NP = KP + 1
-            KP1 = KP + 1
-            KP2 = IW(KP) + KP
-            DO 520 KP = KP1,KP2
-              PART = (IW(KP)-1)/N
-              KE = IW(KP) - N*PART
-              IF (FLAG(KE).LE.-2) THEN
-                FLAG(KE) = -NFLG
-                IF (BOUND) GO TO 510
-                LEAF(KE) = PART
-                JP = IPE(KE)
-                JP1 = JP + 3
-                JP2 = JP + IW(JP)
-                IF (PART.EQ.0) THEN
-                ELSE IF (PART.EQ.2) THEN
-                  JP1 = JP1 + IW(JP+1)
-                ELSE
-                  JP2 = JP2 - IW(JP+2)
-                END IF
-                IRL = IR
-                DO 500 JP = JP1,JP2
-                  JS = IW(JP)
-                  IF (FLAG(JS).LE.NFLG) GO TO 500
-                  IR = IR + ABS(NV(JS))
-                  FLAG(JS) = NFLG
-  500           CONTINUE
-                IF (IR.EQ.IRL .AND. LAST(KE).EQ.-ME) GO TO 520
-  510           IW(NP) = IW(KP)
-                NP = NP + 1
-              ELSE IF (FLAG(KE).GE.0) THEN
-                GO TO 530
-              END IF
-  520       CONTINUE
-            NP0 = NP
-            GO TO 550
-  530       NP0 = NP
-            KP1 = KP
-            DO 540 KP = KP1,KP2
-              KS = IW(KP)
-              IF (FLAG(KS).LE.NFLG) GO TO 540
-              IR = IR + ABS(NV(KS))
-              FLAG(KS) = NFLG
-              IW(NP) = KS
-              NP = NP + 1
-  540       CONTINUE
-  550       IF (BOUND) IR = COUNT(IS)
-            IF (NP.GT.KP2) THEN
-              KP = IPE(IS)
-              IF (NP+IWFR-KP.GE.LW) THEN
-                CALL MA47FD(N,IPE,FLAG,IW,IWFR-1,IWFR,NCMP)
-                IF (NP+IWFR-KP.GE.LW) THEN
-                  INFO(1) = -3
-                  INFO(2) = NP + IWFR - KP + 1 - LW
-                END IF
-                SHIFT = IPE(IS) - KP
-                KP = KP + SHIFT
-                KP2 = KP2 + SHIFT
-                NP = NP + SHIFT
-                NP0 = NP0 + SHIFT
-              END IF
-              NP = NP + IWFR - KP
-              NP0 = NP0 + IWFR - KP
-              IPE(IS) = IWFR
-              KP1 = KP
-              DO 560 KP = KP1,KP2
-                IW(IWFR) = IW(KP)
-                IWFR = IWFR + 1
-  560         CONTINUE
-              IW(IWFR) = 0
-              IWFR = IWFR + 1
-            END IF
-            IW(NP) = IW(NP0)
-            KP = IPE(IS)
-            IW(NP0) = IW(KP+1)
-            IW(KP+1) = ME + (LOOP-1)*N
-            IW(KP) = NP - KP
-            IF (IR.EQ.0) THEN
-              IR = -NV(IS)
-              NV(IS) = IR
-              RANK = RANK - IR
-              IR = 1
-            END IF
-            IF (CMIN.EQ.ZERO) GO TO 610
-            IF (IR.GT.THRESH) GO TO 610
-            JS = IPR(IR)
-            DO 590 LIST = 1,N
-              IF (JS.LE.0) GO TO 610
-              KP = IPE(JS)
-              IF (IW(KP+1).NE.ME+ (LOOP-1)*N) GO TO 610
-              IF (SIGN(1,NV(JS)).NE.SIGN(1,NV(IS))) GO TO 580
-              KP1 = KP
-              DO 570 KP = KP1 + 2,KP1 + IW(KP1)
-                PART = (IW(KP)-1)/N
-                IE = IW(KP) - PART*N
-                IF (ABS(FLAG(IE)).GT.NFLG) GO TO 580
-                IF (FLAG(IE).EQ.-NFLG) THEN
-                  IF (PART.NE.LEAF(IE)) GO TO 580
-                END IF
-  570         CONTINUE
-              GO TO 600
-  580         JS = NEXT(JS)
-  590       CONTINUE
-  600       IPE(JS) = 0
-            NV(IS) = NV(IS) + NV(JS)
-            NV(JS) = 0
-            FLAG(JS) = -1
-            NS = NEXT(JS)
-            LS = LAST(JS)
-            IF (NS.GT.0) LAST(NS) = IS
-            IF (LS.GT.0) NEXT(LS) = IS
-            LAST(IS) = LS
-            NEXT(IS) = NS
-            IF (IPR(IR).EQ.JS) IPR(IR) = IS
-            COUNT(IS) = IR
-            NEXT(JS) = -LEAF(IS)
-            LEAF(IS) = LEAF(JS)
-            LAST(JS) = -IS
-            GO TO 620
-  610       NS = IPR(IR)
-            IF (NS.GT.0) LAST(NS) = IS
-            NEXT(IS) = NS
-            IPR(IR) = IS
-            LAST(IS) = 0
-            MINR = MIN(MINR,IR)
-            IF(NV(IS).GT.0)MINF = MIN(MINF,IR)
-            COUNT(IS) = IR
-  620     CONTINUE
-  630   CONTINUE
-        IF (IWFR+NSVARS+3.GE.LW) THEN
-          CALL MA47FD(N,IPE,FLAG,IW,IWFR-1,IWFR,NCMP)
-          IF (IWFR+NSVARS+3.GE.LW) THEN
-            INFO(1) = -3
-            INFO(2) = IWFR + NSVARS + 4 - LW
-            RETURN
-          END IF
-        END IF
-        IP = IWFR
-        IWFR = IWFR + 3
-        K2 = 0
-        DO 650 LOOP = 1,3
-          K1 = K2 + 1
-          K2 = K1 + NSC(LOOP) - 1
-          DO 640 K = K1,K2
-            IS = SVARS(K)
-            IF (NV(IS).EQ.0) THEN
-              NSC(LOOP) = NSC(LOOP) - 1
-            ELSE
-              FLAG(IS) = NFLG
-              IW(IWFR) = IS
-              IWFR = IWFR + 1
-            END IF
-  640     CONTINUE
-  650   CONTINUE
-        IW(IP) = IWFR - IP - 1
-        IW(IP+1) = NSC(1)
-        IW(IP+2) = NSC(3)
-        FLAG(ME) = -NFLG
-        IPE(ME) = IP
-  670 CONTINUE
-  680 IF (RANK.LT.N) INFO(1) = INFO(1) + 4
-      INFO(8) = N - RANK
-      INFO(12) = NCMP
-      END
-      SUBROUTINE MA47ID(CNTL,ICNTL)
-      INTEGER ICNTL(7)
-      DOUBLE PRECISION CNTL(2)
-      CNTL(1) = 0.001D0
-      CNTL(2) = 0.0D0
-      ICNTL(1) = 6
-      ICNTL(2) = 6
-      ICNTL(3) = 1
-      ICNTL(4) = 0
-      ICNTL(5) = 5
-      ICNTL(6) = 5
-      ICNTL(7) = 4
-      RETURN
-      END
-      SUBROUTINE MA47JD(N,NE,IRN,JCN,KEEP,IW,IPE,COUNT,PERM,FLAG,IWFR,
-     +                  ICNTL,INFO)
-      INTEGER N,NE,IRN(NE),JCN(NE),KEEP(N),IW(NE+N),IPE(0:N),COUNT(0:N),
-     +        PERM(0:N),FLAG(N),IWFR,ICNTL(3),INFO(4)
-      INTRINSIC MAX,MIN
-      INTEGER I,J,K,L,LDIAG,MP
-      MP = ICNTL(2)
-      LDIAG = ICNTL(3)
-      IF (MP.LE.0) LDIAG = 0
-      INFO(1) = 0
-      DO 10 I = 1,N
-        PERM(I) = 0
-        FLAG(I) = 0
-        COUNT(I) = 0
-   10 CONTINUE
-      COUNT(0) = 0
-      PERM(0) = 0
-      DO 20 I = 1,N
-        J = ABS(KEEP(I))
-        IF (J.LT.1 .OR. J.GT.N) GO TO 80
-        IF (PERM(J).NE.0) GO TO 80
-        PERM(J) = I
-   20 CONTINUE
-      DO 30 K = 1,NE
-        I = IRN(K)
-        J = JCN(K)
-        IF (MIN(I,J).LT.1 .OR. MAX(I,J).GT.N) THEN
-          IRN(K) = 0
-          JCN(K) = 0
-          COUNT(0) = COUNT(0) + 1
-          INFO(1) = 1
-          IF (COUNT(0).LE.1 .AND. LDIAG.GT.1) WRITE (MP,'(2A,I2)')
-     +        ' *** Warning message from subroutine MA47AD ***',
-     +        '  INFO(1) =',INFO(1)
-          IF (COUNT(0).LE.10 .AND. LDIAG.GT.1) WRITE (MP,'(3(I6,A))') K,
-     +        'th entry (in row',I,' and column',J,') ignored'
-        ELSE IF (PERM(I).LE.PERM(J)) THEN
-          COUNT(I) = COUNT(I) + 1
-        ELSE
-          COUNT(J) = COUNT(J) + 1
-        END IF
-   30 CONTINUE
-      IPE(0) = COUNT(0)
-      DO 40 I = 1,N
-        IPE(I) = IPE(I-1) + COUNT(I) + 1
-   40 CONTINUE
-      DO 50 K = 1,NE
-        I = IRN(K)
-        J = JCN(K)
-        IF (PERM(I).LE.PERM(J)) THEN
-          IW(IPE(I)) = J
-          IPE(I) = IPE(I) - 1
-        ELSE
-          IW(IPE(J)) = I
-          IPE(J) = IPE(J) - 1
-        END IF
-   50 CONTINUE
-      IWFR = 1
-      INFO(4) = 0
-      DO 70 I = 1,N
-        L = IPE(I)
-        IPE(I) = IWFR
-        DO 60 K = L + 1,L + COUNT(I)
-          J = IW(K)
-          IF (FLAG(J).NE.I) THEN
-            FLAG(J) = I
-            IWFR = IWFR + 1
-            IW(IWFR) = J
-          ELSE
-            INFO(4) = INFO(4) + 1
-          END IF
-   60   CONTINUE
-        IF (IWFR.GT.IPE(I)) THEN
-          IW(IPE(I)) = IWFR - IPE(I)
-          IWFR = IWFR + 1
-        ELSE
-          IPE(I) = 0
-        END IF
-   70 CONTINUE
-      IF (INFO(4).GT.0) THEN
-        INFO(1) = INFO(1) + 2
-        IF (LDIAG.GT.1) WRITE (MP,'(A/I6,A)')
-     +      ' *** Warning message from subroutine MA47AD ***',
-     +      INFO(4),' duplicate entries found.'
-      END IF
-      INFO(3) = COUNT(0)
-      RETURN
-   80 INFO(1) = -5
-      INFO(2) = I
-      END
-      SUBROUTINE MA47KD(N,IPE,IW,LW,IWFR,KEEP,COUNT,NEXT,LAST,IPR,FLAG,
-     +                  NEXTE,VARS,ICNTL,INFO)
-      INTEGER N,IPE(N),LW,IW(LW),IWFR,KEEP(N),COUNT(N),NEXT(N),LAST(N),
-     +        IPR(N),FLAG(N),NEXTE(N),VARS(N),ICNTL(7),INFO(24)
-      INTRINSIC MIN
-      EXTERNAL MA47FD
-      LOGICAL A11,A22,A21,DIAG
-      INTEGER IE,IEL,IP,IS,JP,JP1,JP2,JP3,JP4,JS,K,KE,KIND,KP,KP1,KP2,
-     +        KS,K1,LDIAG,LIST,LOOP,ME,ML,MP,MS,NCMP,NE,NEL,NSC(3),
-     +        NVARS,NVC,NV1,NV2,PIVE(2),PIVOT(2),RANK
-      MP = ICNTL(2)
-      LDIAG = ICNTL(3)
-      IF (MP.LE.0) LDIAG = 0
-      IF (LDIAG.GT.4) THEN
-        WRITE (MP,'(/A)') '    Row   List'
-        DO 1 IS = 1,N
-          KP = IPE(IS)
-          IF (KP.EQ.0) THEN
-            WRITE (MP,'(I7)') IS
-          ELSE
-            WRITE (MP,'(I7,10I6:/ (7X,10I6))') IS,
-     +        (IW(K),K=KP+1,KP+IW(KP))
-          END IF
-    1   CONTINUE
-      END IF
-      RANK = N
-      NCMP = 0
-      NEL = 0
-      DO 10 IS = 1,N
-        IPR(IS) = 0
-        FLAG(IS) = 4
-   10 CONTINUE
-      DO 210 ML = 1,N
-        IF (NEL.GE.N) GO TO 220
-        MS = KEEP(NEL+1)
-        IF (MS.GT.0) THEN
-          KIND = 1
-          PIVOT(1) = MS
-          PIVOT(2) = MS
-          NEL = NEL + 1
-        ELSE
-          KIND = 2
-          MS = -MS
-          IF (NEL+2.GT.N) GO TO 230
-          IS = -KEEP(NEL+2)
-          IF (IS.LT.0) GO TO 230
-          PIVOT(1) = MS
-          PIVOT(2) = IS
-          NVC = 0
-          NEL = NEL + 2
-        END IF
-        NVARS = 0
-        A21 = .FALSE.
-        DO 180 LOOP = 1,KIND
-          DIAG = .FALSE.
-          MS = PIVOT(LOOP)
-          KE = IPR(MS)
-          PIVE(LOOP) = KE
-          IPR(MS) = 1
-          DO 110 KP = 1,N + 1
-            IF (KE.NE.0) THEN
-              JP = IPE(KE)
-              JP1 = JP + 3
-              JP4 = JP + IW(JP)
-              JP2 = JP1 + IW(JP+1)
-              JP3 = JP4 - IW(JP+2)
-              KP1 = JP1
-              KP2 = JP4
-              DO 20 JP = JP1,JP2 - 1
-                IF (IW(JP).EQ.MS) GO TO 40
-   20         CONTINUE
-              DO 30 JP = JP3 + 1,JP4
-                IF (IW(JP).EQ.MS) GO TO 50
-   30         CONTINUE
-              JP2 = JP4
-              GO TO 60
-   40         JP1 = JP2
-              JP2 = JP4
-              GO TO 60
-   50         JP2 = JP3
-            ELSE
-              JP = IPE(MS)
-              IF (JP.EQ.0) GO TO 120
-              JP1 = JP + 1
-              JP2 = JP + IW(JP)
-            END IF
-   60       DO 70 JP = JP1,JP2
-              IS = IW(JP)
-              IF (FLAG(IS).LE.3-LOOP) THEN
-              ELSE IF (FLAG(IS).EQ.2) THEN
-                FLAG(IS) = 0
-                IF (IS.EQ.MS) THEN
-                  DIAG = .TRUE.
-                ELSE
-                  NVC = NVC + 1
-                END IF
-              ELSE
-                FLAG(IS) = 3 - LOOP
-                IF (IS.EQ.MS) THEN
-                  DIAG = .TRUE.
-                ELSE IF (IS.EQ.PIVOT(2)) THEN
-                  A21 = .TRUE.
-                ELSE
-                  NVARS = NVARS + 1
-                  VARS(NVARS) = IS
-                END IF
-              END IF
-   70       CONTINUE
-            IF (KE.EQ.0) GO TO 120
-            IF (LOOP.EQ.1) THEN
-              IF (KIND.EQ.1) THEN
-                IF (JP1.EQ.KP1 .AND. JP2.EQ.KP2) FLAG(KE) = -2
-              ELSE
-                DO 80 JP = JP1,JP2
-                  IF (IW(JP).EQ.PIVOT(2)) THEN
-                    FLAG(KE) = -2
-                    GO TO 90
-                  END IF
-   80           CONTINUE
-   90         END IF
-            END IF
-            KE = NEXTE(KE)
-  110     CONTINUE
-  120     IF (LOOP.EQ.1) THEN
-            A11 = DIAG
-            ME = PIVOT(2)
-            IF (DIAG) ME = PIVOT(1)
-            NV1 = NVARS
-          ELSE
-            A22 = DIAG
-          END IF
-          KE = PIVE(LOOP)
-          DO 170 KP = 1,N + 1
-            IF (KE.EQ.0) GO TO 180
-            IF (FLAG(KE).LE.-2) THEN
-              IE = KE
-              DO 130 LIST = 1,N
-                IF (NEXT(IE).EQ.0) GO TO 140
-                IEL = IE
-                IE = -LAST(IE)
-                IF (IE.EQ.ME) GO TO 150
-                LAST(IEL) = -ME
-  130         CONTINUE
-  140         NEXT(IE) = -ME
-              LAST(IE) = -ME
-              IF (FLAG(KE).EQ.-2 .AND. LOOP.EQ.KIND) FLAG(KE) = -1
-            END IF
-  150       NE = NEXTE(KE)
-            FLAG(MS) = -1
-            IF (FLAG(KE).LE.-2) THEN
-              JP = IPE(KE)
-              JP1 = JP + 3
-              JP2 = JP + IW(JP)
-              JS = N + 1
-              DO 160 JP = JP1,JP2
-                IS = IW(JP)
-                IF (FLAG(IS).GE.0) JS = MIN(JS,NEXT(IS))
-  160         CONTINUE
-              IF (JS.LE.N) THEN
-                JS = ABS(KEEP(JS))
-                NEXTE(KE) = IPR(JS)
-                IPR(JS) = KE
-              ELSE
-                FLAG(KE) = -1
-              END IF
-            END IF
-            KE = NE
-  170     CONTINUE
-  180   CONTINUE
-        NSC(1) = 0
-        NSC(3) = 0
-        IF (KIND.EQ.1) THEN
-          COUNT(MS) = NVARS + 1
-          FLAG(MS) = -1
-        ELSE
-          NV2 = NVARS - NV1 + NVC
-          COUNT(PIVOT(1)) = NV1
-          COUNT(PIVOT(2)) = NV2
-          IF (A11) COUNT(PIVOT(1)) = NV1 + 1
-          IF (A22) COUNT(PIVOT(2)) = NV2 + 1
-          IF (A21) THEN
-            COUNT(PIVOT(1)) = COUNT(PIVOT(1)) + 1
-            COUNT(PIVOT(2)) = COUNT(PIVOT(2)) + 1
-          END IF
-          FLAG(PIVOT(1)) = -1
-          FLAG(PIVOT(2)) = -1
-          KIND = 4
-          IF (A11) THEN
-            IF (A21 .AND. .NOT.A22) THEN
-              KIND = 2
-              NSC(1) = NVARS - NV2
-              IPR(PIVOT(2)) = -1
-            END IF
-          ELSE
-            IF (A21) THEN
-              IF (A22) THEN
-                KIND = 2
-                NSC(3) = NV2 - NVC
-                IPR(PIVOT(1)) = -1
-              ELSE
-                KIND = 3
-                IPR(PIVOT(1)) = -1
-                IPR(PIVOT(2)) = -1
-                NSC(1) = NVARS - NV2
-                NSC(3) = NV2 - NVC
-              END IF
-            END IF
-          END IF
-          IF (.NOT.A22) THEN
-            K1 = 1
-            DO 190 K = 1,NV1
-              IF (FLAG(VARS(K)).EQ.2) THEN
-                KS = VARS(K)
-                VARS(K) = VARS(K1)
-                VARS(K1) = KS
-                K1 = K1 + 1
-              END IF
-  190       CONTINUE
-          END IF
-          IF (ME.EQ.PIVOT(1)) THEN
-            NEXT(PIVOT(2)) = -ME
-            LAST(PIVOT(2)) = -ME
-            COUNT(PIVOT(2)) = -COUNT(PIVOT(2))
-          ELSE
-            NEXT(PIVOT(1)) = -ME
-            LAST(PIVOT(1)) = -ME
-            COUNT(PIVOT(1)) = -COUNT(PIVOT(1))
-          END IF
-          IF (KIND.EQ.4) THEN
-            COUNT(PIVOT(1)) = NVARS + 2
-            COUNT(PIVOT(2)) = NVARS + 2
-            IPR(PIVOT(1)) = 0
-            IPR(PIVOT(2)) = 0
-            IPR(ME) = 2
-          END IF
-        END IF
-        NEXT(ME) = 0
-        IF (NVARS.EQ.0) THEN
-          IF (KIND.EQ.1) THEN
-            IF (.NOT.A11) RANK = RANK - 1
-          ELSE
-            IF (.NOT.A21) THEN
-              IF (.NOT.A11) RANK = RANK - 1
-              IF (.NOT.A22) RANK = RANK - 1
-            END IF
-          END IF
-          IPE(ME) = 0
-          GO TO 210
-        END IF
-        IF (IWFR+NVARS+3.GE.LW) THEN
-          CALL MA47FD(N,IPE,FLAG,IW,IWFR-1,IWFR,NCMP)
-          IF (IWFR+NVARS+3.GE.LW) THEN
-            INFO(1) = -3
-            INFO(2) = IWFR + NVARS + 4 - LW
-            RETURN
-          END IF
-        END IF
-        IP = IWFR
-        IWFR = IWFR + 3
-        MS = N + 1
-        DO 200 K = 1,NVARS
-          IS = VARS(K)
-          MS = MIN(MS,NEXT(IS))
-          FLAG(IS) = 4
-          IW(IWFR) = IS
-          IWFR = IWFR + 1
-  200   CONTINUE
-        IW(IP) = IWFR - IP - 1
-        IW(IP+1) = NSC(1)
-        IW(IP+2) = NSC(3)
-        FLAG(ME) = -4
-        IPE(ME) = IP
-        MS = ABS(KEEP(MS))
-        NEXTE(ME) = IPR(MS)
-        IPR(MS) = ME
-  210 CONTINUE
-  220 IF (RANK.LT.N) INFO(1) = INFO(1) + 4
-      INFO(8) = N - RANK
-      INFO(12) = NCMP
-      RETURN
-  230 INFO(2) = NEL + 1
-      INFO(1) = -6
-      END
-      SUBROUTINE MA47LD(N,FATHER,SON,NODE,COUNT,NE,NA,MARK,PERM,NODES,
-     +                  ICNTL)
-      INTEGER N,FATHER(N),SON(N),NODE(N),COUNT(N),NE(N),NA(N),MARK(N),
-     +        PERM(N),NODES,ICNTL(7)
-      INTEGER COUNT2,I,IBRTHR,IFATHR,ISON,J,K,L,LDIAG,LEVEL,MP,NDE,
-     +        NEMIN,NR,NRL,NST,NVPIV,STAGE
-      MP = ICNTL(2)
-      LDIAG = ICNTL(3)
-      IF (MP.LE.0) LDIAG = 0
-      NEMIN = ICNTL(6)
-      DO 10 I = 1,N
-        SON(I) = 0
-        NODE(I) = 0
-   10 CONTINUE
-      NRL = N + 1
-      DO 20 I = 1,N
-        IFATHR = -FATHER(I)
-        NA(I) = -IFATHR
-        IF (IFATHR.EQ.0) THEN
-          NRL = NRL - 1
-          MARK(NRL) = I
-        ELSE
-          IBRTHR = SON(IFATHR)
-          IF (IBRTHR.GT.0) NA(I) = IBRTHR
-          SON(IFATHR) = I
-          IF (COUNT(I).LT.0) THEN
-            NE(IFATHR) = NE(IFATHR)*2
-            NE(I) = 0
-            NODE(IFATHR) = -COUNT(I)
-          END IF
-        END IF
-   20 CONTINUE
-      NR = NRL
-      I = 0
-      DO 70 K = 1,N
-        IF (I.LE.0) THEN
-          I = MARK(NR)
-          NR = NR + 1
-          LEVEL = N
-          NST = 0
-          PERM(LEVEL) = I
-        END IF
-        DO 30 L = 1,N
-          IF (SON(I).LE.0) GO TO 40
-          ISON = SON(I)
-          SON(I) = 0
-          I = ISON
-          IF (NODE(I).NE.0) NST = NST + 1
-          LEVEL = LEVEL - 1
-          PERM(LEVEL) = I
-   30   CONTINUE
-   40   NVPIV = NE(I)
-        IF (NVPIV.EQ.0) GO TO 60
-        IF (LEVEL.EQ.N) GO TO 60
-        IFATHR = PERM(LEVEL+1)
-        IF (NODE(I).EQ.0 .AND. NODE(IFATHR).EQ.0) THEN
-          IF (COUNT(I)-NVPIV.EQ.COUNT(IFATHR)) GO TO 50
-          IF (NST.GT.0) GO TO 60
-          IF (NVPIV.GE.NEMIN) GO TO 60
-          IF (NE(IFATHR).GE.NEMIN) GO TO 60
-        ELSE
-          IF (NODE(I).EQ.0 .OR. NODE(IFATHR).EQ.0) GO TO 60
-          IF (NVPIV.GT.0 .AND. NE(IFATHR).GT.0) THEN
-            IF (NODE(I)-NVPIV/2.NE.NODE(IFATHR)) GO TO 60
-            IF (COUNT(I)-NVPIV.NE.COUNT(IFATHR)) GO TO 60
-          ELSE IF (NVPIV.LT.0 .AND. NE(IFATHR).LT.0) THEN
-            NVPIV = -NVPIV/2
-            IF (NODE(I)-NVPIV.NE.NODE(IFATHR)) GO TO 60
-            IF (COUNT(I)-NVPIV.NE.COUNT(IFATHR)) GO TO 60
-            IF (COUNT(I).EQ.NODE(I)) GO TO 60
-          ELSE
-            GO TO 60
-          END IF
-          NODE(IFATHR) = NODE(I)
-          NST = NST - 1
-        END IF
-   50   NE(IFATHR) = NE(IFATHR) + NE(I)
-        NE(I) = 0
-        IF (LDIAG.GT.4) WRITE (MP,'(A,2I5)') ' Merging nodes',I,IFATHR
-        COUNT(IFATHR) = COUNT(IFATHR) + NVPIV
-        NODE(I) = -1
-   60   IBRTHR = NA(I)
-        IF (NODE(I).GT.0) NST = NST - 1
-        IF (IBRTHR.GT.0) THEN
-          PERM(LEVEL) = IBRTHR
-          I = IBRTHR
-          IF (NODE(I).GT.0) NST = NST + 1
-        ELSE
-          LEVEL = LEVEL + 1
-          I = -IBRTHR
-        END IF
-   70 CONTINUE
-      DO 80 I = 1,N
-        SON(I) = 0
-   80 CONTINUE
-      DO 90 I = 1,N
-        IFATHR = -FATHER(I)
-        NA(I) = -IFATHR
-        IF (IFATHR.NE.0) THEN
-          IBRTHR = SON(IFATHR)
-          IF (IBRTHR.GT.0) NA(I) = IBRTHR
-          SON(IFATHR) = I
-        END IF
-   90 CONTINUE
-      I = 0
-      NR = NRL
-      DO 120 K = 1,N
-        IF (I.LE.0) THEN
-          I = MARK(NR)
-          NR = NR + 1
-          LEVEL = N
-          PERM(N) = I
-        END IF
-        DO 100 L = 1,N
-          IF (SON(I).LE.0) GO TO 110
-          ISON = SON(I)
-          SON(I) = 0
-          I = ISON
-          FATHER(I) = -PERM(LEVEL)
-          IF (NODE(I).GE.0) THEN
-            LEVEL = LEVEL - 1
-            PERM(LEVEL) = I
-          END IF
-  100   CONTINUE
-  110   IBRTHR = NA(I)
-        IF (IBRTHR.GT.0) THEN
-          IF (NODE(I).LT.0) LEVEL = LEVEL - 1
-          I = IBRTHR
-          PERM(LEVEL) = I
-          FATHER(I) = -PERM(LEVEL+1)
-          IF (NODE(I).LT.0) LEVEL = LEVEL + 1
-        ELSE
-          IF (NODE(I).GE.0) LEVEL = LEVEL + 1
-          I = -IBRTHR
-        END IF
-  120 CONTINUE
-      DO 130 I = 1,N
-        SON(I) = 0
-  130 CONTINUE
-      DO 140 I = 1,N
-        IF (NE(I).EQ.0 .AND. COUNT(I).GE.0) THEN
-          IFATHR = -FATHER(I)
-          IBRTHR = SON(IFATHR)
-          IF (IBRTHR.GT.0) FATHER(I) = IBRTHR
-          SON(IFATHR) = I
-        END IF
-  140 CONTINUE
-      DO 150 I = 1,N
-        IF (COUNT(I).LT.0) THEN
-          IFATHR = -FATHER(I)
-          IBRTHR = SON(IFATHR)
-          IF (IBRTHR.GT.0) FATHER(I) = IBRTHR
-          SON(IFATHR) = I
-        END IF
-  150 CONTINUE
-      DO 160 I = 1,N
-        IF (NE(I).NE.0) THEN
-          IFATHR = -FATHER(I)
-          IF (IFATHR.NE.0) THEN
-            IBRTHR = SON(IFATHR)
-            IF (IBRTHR.GT.0) FATHER(I) = IBRTHR
-            SON(IFATHR) = I
-          END IF
-        END IF
-  160 CONTINUE
-      STAGE = 1
-      I = 0
-      NR = NRL
-      DO 220 K = 1,N
-        IF (I.LE.0) THEN
-          I = MARK(NR)
-          NR = NR + 1
-          LEVEL = N
-          NA(N) = 0
-        END IF
-        L = LEVEL
-        DO 170 LEVEL = L,1,-1
-          IF (SON(I).LE.0) GO TO 180
-          ISON = SON(I)
-          SON(I) = 0
-          I = ISON
-          NA(LEVEL-1) = 0
-  170   CONTINUE
-  180   PERM(K) = I
-        COUNT2 = NODE(I)
-        NODE(I) = STAGE
-        IF (NE(I).EQ.0) GO TO 210
-        IF (LEVEL.LT.N) NA(LEVEL+1) = NA(LEVEL+1) + 1
-        NA(STAGE) = NA(LEVEL)
-        IF (COUNT2.EQ.0) THEN
-          MARK(STAGE) = (COUNT(I)-1)**2
-        ELSE IF (NE(I).GT.0) THEN
-          DO 190 J = K - NE(I) + 1,K - NE(I)/2
-            NODE(PERM(J)) = -NODE(PERM(J))
-  190     CONTINUE
-          MARK(STAGE) = (COUNT(I)+COUNT2-3)* (COUNT2-1)
-        ELSE
-          DO 195 J = K + NE(I) + 1,K
-            NODE(PERM(J)) = -NODE(PERM(J))
-  195     CONTINUE
-          MARK(STAGE) = (COUNT(I)-1)* (COUNT2-1)
-        END IF
-        STAGE = STAGE + 1
-  210   IBRTHR = FATHER(I)
-        IF (IBRTHR.GT.0) THEN
-          NA(LEVEL) = 0
-          I = IBRTHR
-        ELSE
-          LEVEL = LEVEL + 1
-          ISON = I
-          I = -IBRTHR
-        END IF
-  220 CONTINUE
-      NODES = STAGE - 1
-      K = 0
-      L = 1
-      DO 240 NDE = 1,NODES
-        FATHER(NDE) = NODES + 1
-        DO 230 I = 1,NA(NDE)
-          FATHER(NA(K)) = NDE
-          K = K - 1
-  230   CONTINUE
-        K = K + 1
-        NA(K) = NDE
-  240 CONTINUE
-      END
-      SUBROUTINE MA47MD(N,NE,IW,LIW,LROW,PERM,NODES,ELEMS,NODE,PPOS,
-     +                  FATHER,NBLOC,INFO,RINFO)
-      INTEGER N,NE
-      INTEGER LIW,IW(LIW),LROW(N),PERM(N),NODES,ELEMS(NODES),NODE(N),
-     +        PPOS(0:N),FATHER(NODES),NBLOC,INFO(24)
-      DOUBLE PRECISION RINFO(4)
-      DOUBLE PRECISION ZERO
-      PARAMETER (ZERO=0.0D0)
-      INTEGER APOS,APOS1,APOS3,APOS4,ELT,FLAG
-      DOUBLE PRECISION FLOPSB,FLOPSX
-      INTEGER I,IASS,IELL,IELLN,IINPUT,INTSPA,IORG,ISTK,ISW,IWNFS,IWPOS,
-     +        J,J1,J2,JJ,JP1,JP2,JP3,JP4,KIND,LAELL,LEFT,LIELL,LOOP,
-     +        MAXFRT,N1,N2,N3,NCMP,NELL,NFRONT
-      LOGICAL NOSURE
-      INTEGER NOTIN1,NOXO,NPIV,NPOTPV,NSC1,NSC2,NSCHUR,NSTKAC(2),NTILE,
-     +        NTOTPV,NULL,NUM1,NUM2,NUM3,NUMM1,NUMM2,NUMM3,NUMORG,NORG1,
-     +        PTRIRN,RLSPA,RSTKAC
-      INTRINSIC MIN,MAX,ABS
-      EXTERNAL MA47PD
-      NCMP = 0
-      NTILE = 0
-      NOXO = 0
-      FLOPSB = ZERO
-      FLOPSX = ZERO
-      MAXFRT = 0
-      NSTKAC(1) = NE
-      NSTKAC(2) = NE
-      RLSPA = NE
-      INTSPA = NE
-      PTRIRN = LIW - NE + 1
-      ISTK = PTRIRN - 1
-      IINPUT = 0
-      NTOTPV = 0
-      NPOTPV = 0
-      APOS = 1
-      IWPOS = 8
-      DO 10 I = 0,N
-        PPOS(I) = N + 1
-   10 CONTINUE
-      DO 20 I = 1,NODES
-        ELEMS(I) = 0
-   20 CONTINUE
-      DO 380 IASS = 1,NODES
-        INTSPA = MAX(INTSPA,IWPOS+2* (N-NTOTPV)+NSTKAC(2))
-        IF (1+2* (N-NTOTPV).GT.ISTK) THEN
-          CALL MA47PD(IW,ISTK,PTRIRN,IINPUT,NCMP)
-          IF (1+2* (N-NTOTPV).GT.ISTK) THEN
-            INFO(2) = NSTKAC(2) + 1 + 2* (N-NTOTPV)
-            INFO(1) = -3
-            GO TO 390
-          END IF
-        END IF
-        FLAG = ISTK - (N-NTOTPV)
-        NUMORG = 0
-        DO 30 I = NPOTPV + 1,N
-          J = PERM(I)
-          IF (ABS(NODE(J)).GT.IASS) GO TO 40
-          NUMORG = NUMORG + 1
-          IW(NUMORG) = J
-          PPOS(J) = NUMORG
-          IW(FLAG+PPOS(J)) = 0
-   30   CONTINUE
-   40   NULL = 0
-        DO 50 I = 1,NUMORG
-          NULL = NULL + LROW(NPOTPV+I)
-   50   CONTINUE
-        IF (NULL.EQ.0 .AND. ELEMS(IASS).EQ.0) THEN
-          NPOTPV = NPOTPV + NUMORG
-          GO TO 380
-        END IF
-        KIND = 1
-        IF (NUMORG.GE.2) THEN
-          IF (NODE(PERM(NPOTPV+NUMORG/2)).LT.0) THEN
-            KIND = 2
-            IF (NODE(PERM(NPOTPV+NUMORG)).LT.0) KIND = 3
-          END IF
-        END IF
-        IWNFS = NUMORG + 1
-        NORG1 = NUMORG
-        IF (KIND.GT.1) NORG1 = NUMORG/2
-        RSTKAC = 0
-        DO 170 LOOP = 1,MIN(2,KIND)
-          NUM1 = IWNFS - NUMORG - 1
-          NUM2 = 0
-          IF (NULL.EQ.0) GO TO 80
-          J1 = PTRIRN
-          DO 70 IORG = (LOOP-1)*NORG1 + 1,LOOP*NORG1
-            J2 = J1 + LROW(NPOTPV+IORG) - 1
-            DO 60 JJ = J1,J2
-              J = IW(JJ)
-              IF (PPOS(J).LE.N) THEN
-                IF (LOOP.EQ.2) THEN
-                  IF (IW(FLAG+PPOS(J)).EQ.1) THEN
-                    IW(FLAG+PPOS(J)) = 3
-                    NUM2 = NUM2 + 1
-                  END IF
-                END IF
-              ELSE
-                IW(IWNFS) = J
-                IWNFS = IWNFS + 1
-                PPOS(J) = IWNFS - 1
-                IW(FLAG+PPOS(J)) = LOOP
-              END IF
-   60       CONTINUE
-            J1 = J2 + 1
-   70     CONTINUE
-          NSTKAC(2) = NSTKAC(2) - J1 + PTRIRN
-          RSTKAC = RSTKAC + J1 - PTRIRN
-          IINPUT = IINPUT + J1 - PTRIRN
-          PTRIRN = J1
-   80     NELL = ELEMS(IASS)
-          IELL = ISTK + 1
-          PPOS(0) = 0
-          DO 160 ELT = 1,NELL
-            IF (IW(IELL).LT.0) IELL = IELL - IW(IELL)
-            JP1 = IELL + 3
-            JP2 = JP1 + IW(IELL+1)
-            JP3 = JP2 + IW(IELL+2)
-            JP4 = IELL + IW(IELL) - 2
-            J1 = JP1
-            J2 = JP4
-            DO 90 JJ = JP2,JP3 - 1
-              J = IW(JJ)
-              IF (PPOS(J).GE. (LOOP-1)*NORG1+1 .AND.
-     +            PPOS(J).LE.LOOP*NORG1) GO TO 130
-   90       CONTINUE
-            NOTIN1 = 0
-            DO 100 JJ = JP1,JP2 - 1
-              J = IW(JJ)
-              IF (PPOS(J).GE. (LOOP-1)*NORG1+1 .AND.
-     +            PPOS(J).LE.LOOP*NORG1) GO TO 110
-  100       CONTINUE
-            NOTIN1 = 1
-            J2 = JP3 - 1
-  110       DO 120 JJ = JP3,JP4
-              J = IW(JJ)
-              IF (PPOS(J).GE. (LOOP-1)*NORG1+1 .AND.
-     +            PPOS(J).LE.LOOP*NORG1) GO TO 130
-  120       CONTINUE
-            IF (NOTIN1.EQ.1) GO TO 150
-            J1 = JP2
-  130       DO 140 JJ = J1,J2
-              J = IW(JJ)
-              IF (J.EQ.0) GO TO 140
-              IF (PPOS(J).LE.N) THEN
-                NULL = 1
-                IF (LOOP.EQ.2) THEN
-                  IF (IW(FLAG+PPOS(J)).EQ.1) THEN
-                    IW(FLAG+PPOS(J)) = 3
-                    NUM2 = NUM2 + 1
-                  END IF
-                END IF
-              ELSE
-                IW(IWNFS) = J
-                IWNFS = IWNFS + 1
-                PPOS(J) = IWNFS - 1
-                IW(FLAG+PPOS(J)) = LOOP
-              END IF
-  140       CONTINUE
-  150       IELL = IELL + IW(IELL)
-  160     CONTINUE
-  170   CONTINUE
-        PPOS(0) = N + 1
-        IF (NULL.EQ.0) GO TO 190
-        NFRONT = IWNFS - 1
-        MAXFRT = MAX(MAXFRT,NFRONT)
-        IF (KIND.EQ.1) THEN
-          NUM1 = 0
-          NUM2 = NFRONT - NUMORG
-          NUM3 = 0
-        ELSE
-          IF (KIND.EQ.3) THEN
-            JJ = NUMORG
-            J1 = JJ
-            DO 180 J = 1,NUM1
-              JJ = JJ + 1
-              IF (IW(FLAG+JJ).EQ.1) THEN
-                J1 = J1 + 1
-                ISW = IW(JJ)
-                IW(JJ) = IW(J1)
-                IW(J1) = ISW
-                PPOS(IW(JJ)) = JJ
-                PPOS(IW(J1)) = J1
-              END IF
-  180       CONTINUE
-            NUM3 = NFRONT - NUMORG - NUM1
-            NUM1 = NUM1 - NUM2
-          ELSE
-            NUM2 = NUM1
-            NUM1 = 0
-            NUM3 = NFRONT - NUMORG - NUM2
-          END IF
-        END IF
-        RLSPA = MAX(RLSPA,APOS+ (NUMORG* (NUMORG+1))/2+NFRONT*NUMORG+
-     +          NSTKAC(1))
-  190   IF (NULL.NE.0) NTOTPV = NTOTPV + NUMORG
-        NPOTPV = NPOTPV + NUMORG
-        IELL = ISTK + 1
-        DO 250 ELT = 1,NELL
-          IF (IW(IELL).LT.0) IELL = IELL - IW(IELL)
-          LEFT = 0
-          JP1 = IELL + 3
-          JP4 = IELL + IW(IELL) - 2
-          JP2 = JP1 + IW(IELL+1)
-          NUMM1 = IW(IELL+1)
-          NUMM2 = IW(IELL+2)
-          JP3 = JP2 + NUMM2
-          NUMM3 = IW(IELL) - NUMM1 - NUMM2 - 4
-          DO 200 JJ = JP1,JP2 - 1
-            J = IW(JJ)
-            IF (J.EQ.0) GO TO 200
-            IF (PPOS(J).LE.NUMORG) THEN
-              IW(JJ) = 0
-            ELSE
-              LEFT = LEFT + 1
-            END IF
-  200     CONTINUE
-          DO 210 JJ = JP2,JP3 - 1
-            J = IW(JJ)
-            IF (J.EQ.0) GO TO 210
-            IF (PPOS(J).LE.NUMORG) THEN
-              IW(JJ) = 0
-            ELSE
-              LEFT = LEFT + 1
-            END IF
-  210     CONTINUE
-          IF (LEFT.EQ.0) GO TO 230
-          DO 220 JJ = JP3,JP4
-            J = IW(JJ)
-            IF (J.EQ.0) GO TO 220
-            IF (PPOS(J).LE.NUMORG) THEN
-              IW(JJ) = 0
-            ELSE
-              LEFT = LEFT + 1
-            END IF
-  220     CONTINUE
-  230     PPOS(0) = N + 1
-          IELLN = IELL + IW(IELL)
-          IF (LEFT.EQ.0) THEN
-            NELL = NELL - 1
-            ELEMS(IASS) = ELEMS(IASS) - 1
-            LAELL = (NUMM2* (NUMM2+1))/2 + NUMM1* (NUMM2+NUMM3) +
-     +              NUMM2*NUMM3 + 2
-            NSTKAC(1) = NSTKAC(1) - LAELL
-            LIELL = IW(IELL)
-            NSTKAC(2) = NSTKAC(2) - LIELL
-            J1 = IELL
-            J2 = IELLN - 1
-            IF (IELLN.LT.PTRIRN-IINPUT) THEN
-              IF (IW(IELLN).LT.0) THEN
-                LIELL = LIELL - IW(IELLN)
-                J2 = J2 - IW(IELLN)
-              END IF
-            END IF
-            IF ((IELL-1).EQ.ISTK) THEN
-              ISTK = ISTK + LIELL
-            ELSE
-              IF (IW(IELL-1).LT.0) THEN
-                LIELL = LIELL - IW(IELL-1)
-                J1 = IELL + IW(IELL-1)
-              END IF
-              IW(J1) = -LIELL
-              IW(J2) = -LIELL
-            END IF
-          END IF
-          IELL = IELLN
-  250   CONTINUE
-        NSTKAC(1) = NSTKAC(1) - RSTKAC
-        IF (NULL.EQ.0) GO TO 380
-        NPIV = NUMORG
-        IF (KIND.EQ.2) NTILE = NTILE + NPIV/2
-        IF (KIND.EQ.3) NOXO = NOXO + NPIV/2
-        IF (KIND.EQ.1) THEN
-          DO 270 J = 1,NPIV
-            FLOPSB = FLOPSB + 1
-            J2 = NPIV - J
-            DO 260 J1 = 1,NPIV - J
-              FLOPSB = FLOPSB + 1 + 2* (NFRONT-NPIV+J2)
-              J2 = J2 - 1
-  260       CONTINUE
-            FLOPSB = FLOPSB + NUM2
-  270     CONTINUE
-        ELSE
-          DO 290 J = 1,NORG1
-            FLOPSB = FLOPSB + 3 + (NORG1-J)* (2* (NFRONT-NPIV/2-J)+1)
-            J2 = NORG1 - J
-            DO 280 J1 = 1,NORG1 - J
-              FLOPSB = FLOPSB + 4* (NFRONT-NPIV+J2+1)
-              J2 = J2 - 1
-  280       CONTINUE
-            FLOPSB = FLOPSB + NUM1 + 4*NUM2 + NUM3
-  290     CONTINUE
-        END IF
-        NOSURE = (NBLOC.GE. (NFRONT-NUMORG)) .AND. (KIND.EQ.1)
-        IF (NPIV.EQ.NFRONT) GO TO 360
-        IF (KIND.GT.1) THEN
-          NSC1 = NUM1 + NUM2
-          NSC2 = NUM2 + NUM3
-        ELSE
-          NSC1 = NFRONT - NUMORG
-          NSC2 = NFRONT - NUMORG
-        END IF
-        IF (NSC1*NSC2.EQ.0) GO TO 360
-        APOS3 = APOS + (NUMORG* (NUMORG+1))/2 + NFRONT*NPIV
-        IF (NOSURE) THEN
-          RLSPA = MAX(RLSPA,APOS3+ ((NSC1+1)*NSC1)/2+2+NSTKAC(1))
-        ELSE
-          APOS4 = APOS3 + NPIV*NSC2
-          IF (KIND.GT.1) THEN
-            NSCHUR = MAX(NSC1*NSC2+1,NUM1* (NUM2+NUM3)+NUM2*NUM3+
-     +               (NUM2* (NUM2+1))/2+2)
-          ELSE
-            NSCHUR = MAX(NSC1*NSC2+1, (NSC1* (NSC1+1))/2+2)
-          END IF
-          RLSPA = MAX(RLSPA,APOS4+NSCHUR+NSTKAC(1))
-        END IF
-        IF (KIND.GT.1) THEN
-          FLOPSB = FLOPSB + 2*NPIV*NUM1* (NUM2+NUM3)
-          FLOPSB = FLOPSB + NPIV* (2*NUM3+NUM2+1)*NUM2
-          FLOPSX = FLOPSX + NPIV*NUM2*NUM3 +
-     +             NBLOC* (NBLOC-1)*NPIV* (NUM2/NBLOC)
-        ELSE
-          FLOPSB = FLOPSB + NPIV* (NFRONT-NUMORG)* (NFRONT-NUMORG+1)
-          IF (NPIV.GE.NBLOC)
-     +        FLOPSX = FLOPSX + NBLOC* (NBLOC-1)*NPIV* (NUM2/NBLOC)
-        END IF
-        IF (KIND.GT.1) THEN
-          NUMM1 = NUM1
-          NUMM2 = NUM2
-        ELSE
-          NUMM1 = 0
-          NUMM2 = NFRONT - NUMORG
-        END IF
-        NELL = ELEMS(IASS)
-        IELL = ISTK + 1
-        PPOS(0) = 0
-        DO 340 ELT = 1,NELL
-          IF (IW(IELL).LT.0) IELL = IELL - IW(IELL)
-          IELLN = IELL + IW(IELL)
-          JP1 = IELL + 3
-          JP2 = JP1 + IW(IELL+1)
-          JP3 = JP2 + IW(IELL+2)
-          JP4 = IELL + IW(IELL) - 2
-          DO 300 JJ = JP2,JP3 - 1
-            IF (IW(JJ).EQ.0) GO TO 300
-            IF (PPOS(IW(JJ))-NUMORG.LE.NUMM1 .OR.
-     +          PPOS(IW(JJ))-NUMORG.GT.NUMM1+NUMM2) GO TO 330
-  300     CONTINUE
-          APOS1 = 0
-          DO 310 JJ = JP1,JP2 - 1
-            IF (IW(JJ).EQ.0) GO TO 310
-            IF (PPOS(IW(JJ))-NUMORG.LE.NUMM1) THEN
-              IF (APOS1.EQ.2) GO TO 330
-              APOS1 = 1
-            END IF
-            IF (PPOS(IW(JJ))-NUMORG.GT.NUMM1+NUMM2) THEN
-              IF (PPOS(IW(JJ)).EQ.N+1) GO TO 330
-              IF (APOS1.EQ.1) GO TO 330
-              APOS1 = 2
-            END IF
-  310     CONTINUE
-          DO 320 JJ = JP3,JP4
-            IF (IW(JJ).EQ.0) GO TO 320
-            IF (PPOS(IW(JJ))-NUMORG.LE.NUMM1) THEN
-              IF (APOS1.EQ.1) GO TO 330
-            END IF
-            IF (PPOS(IW(JJ))-NUMORG.GT.NUMM1+NUMM2) THEN
-              IF (PPOS(IW(JJ)).EQ.N+1) GO TO 330
-              IF (APOS1.EQ.2) GO TO 330
-            END IF
-  320     CONTINUE
-          NELL = NELL - 1
-          ELEMS(IASS) = ELEMS(IASS) - 1
-          N1 = IW(IELL+1)
-          N2 = IW(IELL+2)
-          N3 = IW(IELL) - 4 - N1 - N2
-          LAELL = (N2* (N2+1))/2 + N1* (N2+N3) + N2*N3 + 2
-          NSTKAC(1) = NSTKAC(1) - LAELL
-          LIELL = IW(IELL)
-          NSTKAC(2) = NSTKAC(2) - LIELL
-          J1 = IELL
-          J2 = IELLN - 1
-          IF (IELLN.LT.PTRIRN-IINPUT) THEN
-            IF (IW(IELLN).LT.0) THEN
-              LIELL = LIELL - IW(IELLN)
-              J2 = J2 - IW(IELLN)
-            END IF
-          END IF
-          IF ((IELL-1).EQ.ISTK) THEN
-            ISTK = ISTK + LIELL
-          ELSE
-            IF (IW(IELL-1).LT.0) THEN
-              LIELL = LIELL - IW(IELL-1)
-              J1 = IELL + IW(IELL-1)
-            END IF
-            IW(J1) = -LIELL
-            IW(J2) = -LIELL
-          END IF
-  330     IELL = IELLN
-  340   CONTINUE
-        PPOS(0) = N + 1
-        ELEMS(FATHER(IASS)) = ELEMS(FATHER(IASS)) + 1
-        IF (KIND.GT.1) THEN
-          LAELL = NUM1* (NUM2+NUM3) + (NUM2* (NUM2+1))/2 + NUM2*NUM3 + 2
-        ELSE
-          LAELL = ((NSC1+1)* (NSC1))/2 + 2
-        END IF
-        NSTKAC(1) = NSTKAC(1) + LAELL
-        LIELL = NFRONT - NUMORG + 4
-        NSTKAC(2) = NSTKAC(2) + LIELL
-        INTSPA = MAX(INTSPA,IWPOS+2*NFRONT+LIELL+NSTKAC(2))
-        IF (1+2*NFRONT+LIELL.GT.ISTK) THEN
-          CALL MA47PD(IW,ISTK,PTRIRN,IINPUT,NCMP)
-          IF (1+2*NFRONT+LIELL.GT.ISTK) THEN
-            INFO(2) = NSTKAC(2) + 1 + 2*NFRONT + LIELL
-            INFO(1) = -3
-            GO TO 390
-          END IF
-        END IF
-        IW(ISTK) = LIELL
-        ISTK = ISTK - 1
-        DO 350 I = 1,NFRONT - NUMORG
-          IW(ISTK) = IW(NFRONT+1-I)
-          ISTK = ISTK - 1
-  350   CONTINUE
-        IF (KIND.GT.1) THEN
-          IW(ISTK) = NUM2
-          IW(ISTK-1) = NUM1
-        ELSE
-          IW(ISTK) = NFRONT - NUMORG
-          IW(ISTK-1) = 0
-        END IF
-        IW(ISTK-2) = LIELL
-        ISTK = ISTK - 3
-  360   DO 370 JJ = NPIV + 1,NFRONT
-          J = ABS(IW(JJ))
-          PPOS(J) = N + 1
-  370   CONTINUE
-        IF (FATHER(IASS).LE.NODES) THEN
-          ELEMS(FATHER(IASS)) = ELEMS(FATHER(IASS)) + NELL
-        END IF
-C********************************
-C********************************
-        IF (KIND.EQ.1) THEN
-          IWPOS = IWPOS - 2
-          APOS = APOS + (NPIV* (NPIV+1))/2 + NPIV* (NFRONT-NPIV)
-        ELSE
-          IF (KIND.EQ.2) THEN
-            IWPOS = IWPOS - 1
-            APOS = APOS + 3* (NORG1* (NORG1+1))/2 +
-     +             NORG1* (NUM1+2*NUM2+NUM3)
-          ELSE
-            APOS = APOS + NORG1* (NORG1+2) + NORG1* (NUM1+2*NUM2+NUM3)
-          END IF
-        END IF
-        IWPOS = IWPOS + NFRONT + 4
-  380 CONTINUE
-      INFO(5) = NODES
-      INFO(6) = MAX(2*NE,RLSPA)
-      INFO(7) = MAX(2*NE,INTSPA)
-      INFO(8) = N - NTOTPV
-      INFO(9) = MAXFRT
-      INFO(10) = APOS - 1
-      INFO(11) = IWPOS - 5
-      INFO(12) = INFO(12) + NCMP
-      INFO(13) = NTILE
-      INFO(14) = NOXO
-      RINFO(1) = FLOPSB
-      RINFO(2) = FLOPSX
-  390 RETURN
-      END
-      SUBROUTINE MA47ND(N,NE,IRN,JCN,MAP,LROW,PERM,COUNT,PERM0)
-      INTEGER N,NE
-      INTEGER IRN(NE),JCN(NE),MAP(NE),LROW(N),PERM(N),COUNT(0:N),
-     +        PERM0(0:N)
-      INTEGER I,J,K
-      COUNT(0) = 0
-      PERM0(0) = 0
-      DO 10 I = 1,N
-        COUNT(I) = 0
-        PERM0(PERM(I)) = I
-   10 CONTINUE
-      DO 20 K = 1,NE
-        I = IRN(K)
-        J = JCN(K)
-        IF (PERM0(I).LE.PERM0(J)) THEN
-          I = PERM0(I)
-          COUNT(I) = COUNT(I) + 1
-        ELSE
-          JCN(K) = I
-          IRN(K) = J
-          J = PERM0(J)
-          COUNT(J) = COUNT(J) + 1
-        END IF
-   20 CONTINUE
-      DO 30 I = 1,N
-        LROW(I) = COUNT(I)
-        COUNT(I) = COUNT(I-1) + LROW(I)
-   30 CONTINUE
-      DO 40 K = 1,NE
-        I = PERM0(IRN(K))
-        MAP(K) = COUNT(I)
-        COUNT(I) = COUNT(I) - 1
-   40 CONTINUE
-      RETURN
-      END
-      SUBROUTINE MA47OD(N,NE,A,LA,IW,LIW,LROW,PERM,NODES,ELEMS,MARK,
-     +                  NODE,PPOS,FATHER,CNTL,NBLOC,INFO,RINFO)
-      INTEGER N,NE,LA
-      DOUBLE PRECISION A(LA),CNTL(2),RINFO(4)
-      INTEGER LIW,IW(LIW),LROW(N),PERM(N),NODES,ELEMS(NODES),
-     +        MARK(NODES),NODE(N),PPOS(0:N),FATHER(NODES),NBLOC,INFO(24)
-      DOUBLE PRECISION ZERO,HALF,ONE
-      PARAMETER (ZERO=0.0D0,HALF=0.5D0,ONE=1.0D0)
-      INTEGER AINPUT
-      DOUBLE PRECISION AMAX,A1MAX,AMULT1,AMULT2
-      INTEGER APOS,APOSA,APOSB,APOSBB,APOSC,APOSH,APOSI,APOSJ,APOS1,
-     +        APOS2,APOS3,APOS4,ASTK,ATRASH,CNTNZ1,CNTNZ2
-      DOUBLE PRECISION DETPIV
-      INTEGER ELT
-      DOUBLE PRECISION FLOPSB,FLOPSX
-      INTEGER I,I1,IASS,IBEG,IELL,IELLN,IEND,IEXCH,IINPUT,INC,INTSPA,
-     +        IORG,IPIV,IPOS,IROW,ISTK,ISWOP,IWNFS,IWPOS,J,JA1,JA2,JAY,
-     +        J1,J2,JCOL,JJ,JJJ,JMAX,J1MAX,JP1,JP2,JP3,JP4,JPIV,K,K1,K2,
-     +        KBLK,KIND,KR,KROW,KSWEEP,L,LAELL,LDUMMY,LEFT,LIELL,LNPIV,
-     +        LPIV
-      LOGICAL LTWO
-      INTEGER MA1,MAXFRT
-      DOUBLE PRECISION MAXPIV
-      INTEGER NASS,NBLK,NCMPBI,NCMPBR,NCOL,NEIG,NELL,NFRONT,NFS,NFULLB,
-     +        NIRBDU,NNELL,NNULL
-      LOGICAL NOSURE
-      INTEGER NOTIN1,NOXOB,NPIV,NPIVD2,NPOTPV,NRLBDU,NSC1,NSC2,NSCHUR,
-     +        NSTKAC(2),NSTRUC,NTILEB,NTOTPV,NUM1,NUM2,NUM3,NUMM1,NUMM2,
-     +        NUMORG,NUMPVT,OFFDAG
-      DOUBLE PRECISION PIVOT
-      INTEGER PIVSIZ,POSELT,POSPV1,POSPV2,PTRA,PTRELT,PTRIRN,RLSPA
-      DOUBLE PRECISION RMAX,SWOP,TMAX,TOL,UU
-      INTEGER ZCOL
-      DOUBLE PRECISION ZONE
-C?? We could refine this count and have NCOLST, NCOLP etc.
-      INTRINSIC MIN,MAX,ABS,NINT
-      INTEGER IDAMAX
-      EXTERNAL MA47PD,MA47SD,MA47YD,MA47WD,MA47XD,IDAMAX,DGEMM
-      TOL = CNTL(2)
-      NBLK = 0
-      NTILEB = 0
-      NOXOB = 0
-      NFULLB = 0
-      NCMPBI = 0
-      NCMPBR = 0
-      FLOPSB = ZERO
-      FLOPSX = ZERO
-      NEIG = 0
-      MAXFRT = 0
-      UU = MIN(CNTL(1),HALF)
-      UU = MAX(UU,ZERO)
-      DO 10 I = 0,N
-        PPOS(I) = N + 1
-   10 CONTINUE
-      DO 20 I = 1,NODES
-        ELEMS(I) = 0
-   20 CONTINUE
-      IWPOS = 8
-      APOSBB = 1
-      NSTKAC(1) = NE
-      NSTKAC(2) = NE
-      INTSPA = NE
-      RLSPA = NE
-      PTRIRN = LIW - NE + 1
-      PTRA = LA - NE + 1
-      ISTK = PTRIRN - 1
-      ASTK = PTRA - 1
-      AINPUT = 0
-      IINPUT = 0
-      NTOTPV = 0
-      NPOTPV = 0
-      DO 2160 IASS = 1,NODES
-        NNULL = 0
-        INTSPA = MAX(INTSPA,IWPOS+2* (N-NTOTPV)+NSTKAC(2))
-        IF (IWPOS+2* (N-NTOTPV).GT.ISTK) THEN
-          CALL MA47PD(IW,ISTK,PTRIRN,IINPUT,NCMPBI)
-          IF (IWPOS+2* (N-NTOTPV).GT.ISTK) THEN
-            INFO(2) = INTSPA
-            INFO(1) = -3
-            GO TO 2170
-          END IF
-        END IF
-        NUMORG = 0
-        DO 30 I = NPOTPV + 1,N
-          J = PERM(I)
-          IF (ABS(NODE(J)).GT.IASS) GO TO 40
-          IW(IWPOS+NUMORG) = J
-          NUMORG = NUMORG + 1
-          PPOS(J) = NUMORG
-   30   CONTINUE
-   40   KIND = 1
-        IF (NUMORG.GE.2) THEN
-          IF (NODE(PERM(NPOTPV+NUMORG/2)).LT.0) THEN
-            KIND = 2
-            NUMPVT = NUMORG/2
-            IF (NODE(PERM(NPOTPV+NUMORG)).LT.0) KIND = 3
-          END IF
-        END IF
-        NASS = NUMORG
-        NELL = ELEMS(IASS)
-        NNELL = NELL
-        IELL = ISTK + 1
-        DO 70 ELT = 1,NELL
-          IF (IW(IELL).LT.0) IELL = IELL - IW(IELL)
-          IF (IW(IELL+1).NE.-1) GO TO 60
-          DO 50 JJ = IELL + 3,IELL + 2 + IW(IELL+2)
-            J = IW(JJ)
-            IW(IWPOS+NASS) = J
-            NASS = NASS + 1
-            PPOS(J) = NASS
-   50     CONTINUE
-   60     IELL = IELL + IW(IELL)
-   70   CONTINUE
-        IWNFS = IWPOS + NASS
-        J1 = PTRIRN
-        DO 90 IORG = 1,NUMORG
-          J2 = J1 + LROW(NPOTPV+IORG) - 1
-          DO 80 JJ = J1,J2
-            J = IW(JJ)
-            IF (PPOS(J).LE.N) GO TO 80
-            IW(IWNFS) = J
-            IWNFS = IWNFS + 1
-            PPOS(J) = IWNFS - IWPOS
-   80     CONTINUE
-          J1 = J2 + 1
-   90   CONTINUE
-        IELL = ISTK + 1
-        DO 170 ELT = 1,NELL
-          IF (IW(IELL).LT.0) IELL = IELL - IW(IELL)
-          IF (IW(IELL+1).EQ.-1) GO TO 160
-          JP1 = IELL + 3
-          JP2 = JP1 + IW(IELL+1)
-          JP3 = JP2 + IW(IELL+2)
-          JP4 = IELL + IW(IELL) - 2
-          J1 = JP1
-          J2 = JP4
-          DO 100 JJ = JP2,JP3 - 1
-            J = IW(JJ)
-            IF (PPOS(J).LE.NASS) GO TO 140
-  100     CONTINUE
-          NOTIN1 = 0
-          DO 110 JJ = JP1,JP2 - 1
-            J = IW(JJ)
-            IF (PPOS(J).LE.NASS) GO TO 120
-  110     CONTINUE
-          NOTIN1 = 1
-          J2 = JP3 - 1
-  120     DO 130 JJ = JP3,JP4
-            J = IW(JJ)
-            IF (PPOS(J).LE.NASS) GO TO 140
-  130     CONTINUE
-          IF (NOTIN1.EQ.1) GO TO 160
-          J1 = JP2
-  140     PPOS(0) = 0
-          DO 150 JJ = J1,J2
-            J = IW(JJ)
-            IF (PPOS(J).LE.N) GO TO 150
-            IW(IWNFS) = J
-            IWNFS = IWNFS + 1
-            PPOS(J) = IWNFS - IWPOS
-  150     CONTINUE
-          PPOS(0) = N + 1
-  160     IELL = IELL + IW(IELL)
-  170   CONTINUE
-        NCOL = IWNFS - IWPOS
-        IELL = ISTK + 1
-        DO 200 ELT = 1,NELL
-          IF (IW(IELL).LT.0) IELL = IELL - IW(IELL)
-          IF (IW(IELL+1).NE.-1) GO TO 190
-          PPOS(0) = 0
-          DO 180 JJ = IELL + 3 + IW(IELL+2),IELL + IW(IELL) - 2
-            J = IW(JJ)
-            IF (PPOS(J).LE.N) GO TO 180
-            IW(IWNFS) = J
-            IWNFS = IWNFS + 1
-            PPOS(J) = IWNFS - IWPOS
-  180     CONTINUE
-          PPOS(0) = N + 1
-  190     IELL = IELL + IW(IELL)
-  200   CONTINUE
-        NFRONT = IWNFS - IWPOS
-        MAXFRT = MAX(MAXFRT,NFRONT)
-        IF (INFO(1).NE.-4) THEN
-          APOS = APOSBB + (NASS* (NASS+1))/2
-        ELSE
-          APOS = 1
-        END IF
-        RLSPA = MAX(RLSPA,INFO(2)+APOS+NFRONT*NASS+NSTKAC(1))
-        IF (APOS+NFRONT*NASS.GT.ASTK) THEN
-          CALL MA47SD(A,ASTK,PTRA,AINPUT,NCMPBR)
-          IF (APOS+NFRONT*NASS.GT.ASTK) THEN
-            INFO(2) = INFO(2) + APOS - 1
-            APOS = 1
-            APOSBB = 1
-            INFO(1) = -4
-            IF (NFRONT*NASS.GT.ASTK) THEN
-              INFO(2) = RLSPA
-              GO TO 2170
-            END IF
-          END IF
-        END IF
-        ATRASH = APOS + NFRONT*NASS
-        DO 210 JJ = APOS,ATRASH
-          A(JJ) = ZERO
-  210   CONTINUE
-        J1 = PTRIRN
-        DO 230 IORG = 1,NUMORG
-          J = PERM(NPOTPV+IORG)
-          APOSI = APOS + (PPOS(J)-1)*NFRONT - 1
-          J2 = J1 + LROW(NPOTPV+IORG) - 1
-          DO 220 JJ = J1,J2
-            APOS2 = APOSI + PPOS(IW(JJ))
-            A(APOS2) = A(APOS2) + A(PTRA)
-            PTRA = PTRA + 1
-  220     CONTINUE
-          AINPUT = AINPUT + J2 - J1 + 1
-          NSTKAC(1) = NSTKAC(1) - J2 + J1 - 1
-          J1 = J2 + 1
-  230   CONTINUE
-        IINPUT = IINPUT + J1 - PTRIRN
-        NSTKAC(2) = NSTKAC(2) - J1 + PTRIRN
-        PTRIRN = J1
-        NPOTPV = NPOTPV + NUMORG
-        NFS = NUMORG
-        IELL = ISTK + 1
-        PTRELT = ASTK + 1
-        DO 380 ELT = 1,NELL
-          IF (NINT(A(PTRELT)).LT.0) PTRELT = PTRELT - NINT(A(PTRELT))
-          IF (IW(IELL).LT.0) IELL = IELL - IW(IELL)
-          LEFT = 0
-          POSELT = PTRELT + 1
-          JP1 = IELL + 3
-          JP4 = IELL + IW(IELL) - 2
-          IF (IW(IELL+1).NE.-1) GO TO 260
-          LIELL = JP4 - JP1 + 1
-          I1 = 1
-          DO 250 JJ = JP1,JP4
-            J = IW(JJ)
-            APOS2 = APOS + NFS*NFRONT - 1 + PPOS(J)
-            APOS1 = POSELT
-            DO 240 I = 1,MIN(I1,IW(IELL+2))
-              A(APOS2) = A(APOS1)
-              APOS1 = APOS1 + LIELL
-              APOS2 = APOS2 + NFRONT
-  240       CONTINUE
-            I1 = I1 + 1
-            POSELT = POSELT + 1
-  250     CONTINUE
-          NFS = NFS + IW(IELL+2)
-          GO TO 370
-  260     JP2 = JP1 + IW(IELL+1)
-          NUM1 = IW(IELL+1)
-          NUM2 = IW(IELL+2)
-          JP3 = JP2 + NUM2
-          NUM3 = IW(IELL) - NUM1 - NUM2 - 4
-          DO 280 JJ = JP1,JP2 - 1
-            J = IW(JJ)
-            IF (J.EQ.0) GO TO 280
-            IF (PPOS(J).LE.NASS) THEN
-              POSELT = PTRELT + 1 + (JJ-JP1)* (NUM2+NUM3)
-              APOSI = APOS + (PPOS(J)-1)*NFRONT - 1
-              PPOS(0) = ATRASH - APOSI
-              DO 270 JJJ = JP2,JP4
-                APOS2 = APOSI + PPOS(IW(JJJ))
-                A(APOS2) = A(APOS2) + A(POSELT)
-                POSELT = POSELT + 1
-  270         CONTINUE
-              IW(JJ) = 0
-            ELSE
-              LEFT = LEFT + 1
-            END IF
-  280     CONTINUE
-          DO 320 JJ = JP2,JP3 - 1
-            J = IW(JJ)
-            IF (J.EQ.0) GO TO 320
-            IF (PPOS(J).LE.NASS) THEN
-              POSELT = PTRELT + 1 + JJ - JP2
-              INC = NUM2 + NUM3
-              APOSI = APOS + (PPOS(J)-1)*NFRONT - 1
-              PPOS(0) = ATRASH - APOSI
-              DO 290 JJJ = JP1,JP2 - 1
-                APOS2 = APOSI + PPOS(IW(JJJ))
-                A(APOS2) = A(APOS2) + A(POSELT)
-                POSELT = POSELT + INC
-  290         CONTINUE
-              DO 300 JJJ = JP2,JJ - 1
-                APOS2 = APOSI + PPOS(IW(JJJ))
-                A(APOS2) = A(APOS2) + A(POSELT)
-                INC = INC - 1
-                POSELT = POSELT + INC
-  300         CONTINUE
-              DO 310 JJJ = JJ,JP4
-                APOS2 = APOSI + PPOS(IW(JJJ))
-                A(APOS2) = A(APOS2) + A(POSELT)
-                POSELT = POSELT + 1
-  310         CONTINUE
-              IW(JJ) = 0
-            ELSE
-              LEFT = LEFT + 1
-            END IF
-  320     CONTINUE
-          IF (LEFT.EQ.0) GO TO 360
-          DO 350 JJ = JP3,JP4
-            J = IW(JJ)
-            IF (J.EQ.0) GO TO 350
-            IF (PPOS(J).LE.NASS) THEN
-              POSELT = PTRELT + 1 + NUM2 + JJ - JP3
-              APOSI = APOS + (PPOS(J)-1)*NFRONT - 1
-              PPOS(0) = ATRASH - APOSI
-              INC = NUM2 + NUM3
-              DO 330 JJJ = JP1,JP2 - 1
-                APOS2 = APOSI + PPOS(IW(JJJ))
-                A(APOS2) = A(APOS2) + A(POSELT)
-                POSELT = POSELT + INC
-  330         CONTINUE
-              DO 340 JJJ = JP2,JP3 - 1
-                APOS2 = APOSI + PPOS(IW(JJJ))
-                A(APOS2) = A(APOS2) + A(POSELT)
-                INC = INC - 1
-                POSELT = POSELT + INC
-  340         CONTINUE
-              IW(JJ) = 0
-            ELSE
-              LEFT = LEFT + 1
-            END IF
-  350     CONTINUE
-  360     PPOS(0) = N + 1
-  370     IELLN = IELL + IW(IELL)
-          POSELT = PTRELT + NINT(A(PTRELT))
-          IF (LEFT.EQ.0) THEN
-            NELL = NELL - 1
-            NNELL = NELL
-            ELEMS(IASS) = ELEMS(IASS) - 1
-            LIELL = IW(IELL)
-            NSTKAC(2) = NSTKAC(2) - LIELL
-            J1 = IELL
-            J2 = IELLN - 1
-            IF (IELLN.LT.PTRIRN-IINPUT) THEN
-              IF (IW(IELLN).LT.0) THEN
-                LIELL = LIELL - IW(IELLN)
-                J2 = J2 - IW(IELLN)
-              END IF
-            END IF
-            IF ((IELL-1).EQ.ISTK) THEN
-              ISTK = ISTK + LIELL
-            ELSE
-              IF (IW(IELL-1).LT.0) THEN
-                LIELL = LIELL - IW(IELL-1)
-                J1 = IELL + IW(IELL-1)
-              END IF
-              IW(J1) = -LIELL
-              IW(J2) = -LIELL
-            END IF
-            LAELL = NINT(A(PTRELT))
-            NSTKAC(1) = NSTKAC(1) - LAELL
-            JA1 = PTRELT
-            JA2 = POSELT - 1
-            IF (POSELT.LT.PTRA-AINPUT) THEN
-              IF (NINT(A(POSELT)).LT.0) THEN
-                LAELL = LAELL - NINT(A(POSELT))
-                JA2 = JA2 - NINT(A(POSELT))
-              END IF
-            END IF
-            IF (PTRELT-1.EQ.ASTK) THEN
-              ASTK = ASTK + LAELL
-            ELSE
-              IF (NINT(A(PTRELT-1)).LT.0) THEN
-                LAELL = LAELL - NINT(A(PTRELT-1))
-                JA1 = PTRELT + NINT(A(PTRELT-1))
-              END IF
-              A(JA1) = -LAELL
-              A(JA2) = -LAELL
-            END IF
-          END IF
-          IELL = IELLN
-          PTRELT = POSELT
-  380   CONTINUE
-        DO 410 I = 1,NUMORG
-          APOS2 = APOS + (NFRONT+1)* (I-1)
-          DO 390 J = 1,NUMORG - I
-            A(APOS2+J*NFRONT) = A(APOS2+J*NFRONT) + A(APOS2+J)
-  390     CONTINUE
-          DO 400 J = 1,NASS - I
-            A(APOS2+J) = A(APOS2+J*NFRONT)
-  400     CONTINUE
-  410   CONTINUE
-        NPIV = 0
-        NSTRUC = 0
-        IF (KIND.EQ.1) GO TO 760
-        DO 440 K = 1,KIND - 1
-          POSELT = APOS + (K-1)* (NUMORG/2* (NFRONT+1)) - 1
-          DO 430 I = 1,NUMORG/2
-            DO 420 J = I,NUMORG/2
-              IF (A(POSELT+J).NE.ZERO) GO TO 760
-  420       CONTINUE
-            POSELT = POSELT + NFRONT
-  430     CONTINUE
-  440   CONTINUE
-        CNTNZ1 = NCOL - NASS
-        CNTNZ2 = NCOL - NASS
-        DO 480 J = NASS + 1,NCOL
-          JA1 = APOS + J - 1
-          DO 450 I = 1,NUMPVT
-            IF (A(JA1).NE.ZERO) GO TO 460
-            JA1 = JA1 + NFRONT
-  450     CONTINUE
-          CNTNZ1 = CNTNZ1 - 1
-  460     IF (KIND.EQ.3) THEN
-            JA2 = APOS + NFRONT*NUMPVT + J - 1
-            DO 470 I = 1,NUMPVT
-              IF (A(JA2).NE.ZERO) GO TO 480
-              JA2 = JA2 + NFRONT
-  470       CONTINUE
-            CNTNZ2 = CNTNZ2 - 1
-          END IF
-  480   CONTINUE
-        MA1 = (CNTNZ1+NUMPVT-1)* (CNTNZ2+ NUMPVT-1)
-        IF (FATHER(IASS).NE.NODES+1) THEN
-        END IF
-        DO 650 KSWEEP = 1, (NUMORG-NPIV)/2
-          NNULL = 0
-          LNPIV = NPIV
-          NPIVD2 = NPIV/2
-          DO 640 IPIV = NPIVD2 + 1,NUMPVT
-            APOSI = APOS + NUMPVT + NPIVD2 + (IPIV-1)*NFRONT
-            JMAX = IDAMAX(NUMPVT-NPIVD2,A(APOSI),1)
-            OFFDAG = APOSI + JMAX - 1
-            JMAX = JMAX + NUMPVT + NPIVD2
-            PIVOT = A(OFFDAG)
-            A(OFFDAG) = ZERO
-            JJ = IDAMAX(NCOL- (NUMPVT+NPIVD2),A(APOSI),1)
-            RMAX = ABS(A(APOSI+JJ-1))
-            IF (MAX(RMAX,ABS(PIVOT)).LE.TOL) THEN
-              NNULL = NNULL + 1
-              GO TO 640
-            END IF
-            IF (ABS(PIVOT).LE.TOL) GO TO 640
-            POSPV1 = APOS + (IPIV-1)* (NFRONT+1)
-            POSPV2 = APOS + (JMAX-1)* (NFRONT+1)
-            IF (MA1.EQ.0) THEN
-              DETPIV = -PIVOT*PIVOT
-              IF (ABS(DETPIV/PIVOT).LE.TOL) GO TO 640
-              A(OFFDAG) = PIVOT
-              GO TO 530
-            END IF
-            APOSJ = APOS + (JMAX-1)*NFRONT
-            AMULT2 = A(POSPV2)
-            A(POSPV2) = ZERO
-            J1MAX = NPIVD2 + IDAMAX(NUMPVT-NPIVD2,
-     +              A(APOS+NPIVD2*NFRONT+JMAX-1),NFRONT)
-            TMAX = ABS(A(APOS+JMAX-1+ (J1MAX-1)*NFRONT))
-            IF ( JMAX-1- (NUMPVT+NPIVD2) .GT. 0)THEN
-               J1MAX = NUMPVT + NPIVD2 + IDAMAX(JMAX-1- (NUMPVT+NPIVD2),
-     +              A(APOS+ (NUMPVT+NPIVD2)*NFRONT+JMAX-1),NFRONT)
-               TMAX = MAX(TMAX,ABS(A(APOS+JMAX-1+ (J1MAX-1)*NFRONT)))
-            END IF
-            J1MAX = JMAX - 1 + IDAMAX(NCOL-JMAX+1,A(POSPV2),1)
-            TMAX = MAX(TMAX,ABS(A(APOSJ+J1MAX-1)))
-            A(POSPV2) = AMULT2
-            A(OFFDAG) = PIVOT
-            DETPIV = -PIVOT*PIVOT
-            IF (ABS(DETPIV/PIVOT).LE.TOL) GO TO 640
-            IF ((ABS(A(POSPV2))*RMAX+ABS(PIVOT)*TMAX)*UU.GT.
-     +          ABS(DETPIV)) GO TO 490
-            IF ((ABS(PIVOT)*RMAX)*UU.GT.ABS(DETPIV)) GO TO 490
-            GO TO 530
-  490       IF (KIND.EQ.3) GO TO 640
-            IF (ABS(A(POSPV2)).LT.UU*TMAX) GO TO 640
-            TMAX = ZERO
-            AMULT2 = - (A(OFFDAG)/A(POSPV2))
-            JA1 = APOS + NPIVD2*NFRONT + (JMAX-1)
-            DO 500 J = NPIVD2 + 1,NUMPVT
-              TMAX = MAX(TMAX,ABS(A(JA1)*AMULT2))
-              JA1 = JA1 + NFRONT
-  500       CONTINUE
-            JA1 = APOS + (NUMPVT+NPIVD2)*NFRONT + (JMAX-1)
-            JA2 = APOS + (IPIV-1)*NFRONT + NUMPVT + NPIVD2
-            DO 510 J = NUMPVT + NPIVD2 + 1,JMAX - 1
-              TMAX = MAX(TMAX,ABS(A(JA2)+A(JA1)*AMULT2))
-              JA1 = JA1 + NFRONT
-              JA2 = JA2 + 1
-  510       CONTINUE
-            JA1 = APOS + (JMAX-1)*NFRONT + JMAX
-            JA2 = APOS + (IPIV-1)*NFRONT + JMAX
-            DO 520 J = JMAX + 1,NCOL
-              TMAX = MAX(TMAX,ABS(A(JA2)+A(JA1)*AMULT2))
-              JA1 = JA1 + 1
-              JA2 = JA2 + 1
-  520       CONTINUE
-            IF (ABS(DETPIV/A(POSPV2)).LT.UU*TMAX) GO TO 640
-  530       IF (IPIV.EQ.NPIVD2+1) GO TO 550
-            JA1 = APOS + (IPIV-1)*NFRONT + NUMPVT
-            J1 = APOS + NPIVD2*NFRONT + NUMPVT
-            DO 540 JJ = 1,NCOL - NUMPVT
-              SWOP = A(JA1)
-              A(JA1) = A(J1)
-              A(J1) = SWOP
-              JA1 = JA1 + 1
-              J1 = J1 + 1
-  540       CONTINUE
-            IPOS = IWPOS + NPIVD2
-            IEXCH = IWPOS + IPIV - 1
-            ISWOP = IW(IPOS)
-            IW(IPOS) = IW(IEXCH)
-            IW(IEXCH) = ISWOP
-  550       IF (JMAX.EQ.NUMPVT+NPIVD2+1) GO TO 590
-            JA1 = APOS + JMAX - 1
-            J1 = APOS + NUMPVT + NPIVD2
-            DO 560 JJ = 1,NUMPVT + NPIVD2
-              SWOP = A(JA1)
-              A(JA1) = A(J1)
-              A(J1) = SWOP
-              JA1 = JA1 + NFRONT
-              J1 = J1 + NFRONT
-  560       CONTINUE
-            JA1 = APOS + (NUMPVT+NPIVD2+1)*NFRONT + JMAX - 1
-            J1 = APOS + (NUMPVT+NPIVD2)* (NFRONT+1) + 1
-            DO 570 JJ = NUMPVT + NPIVD2 + 2,JMAX - 1
-              SWOP = A(JA1)
-              A(JA1) = A(J1)
-              A(J1) = SWOP
-              JA1 = JA1 + NFRONT
-              J1 = J1 + 1
-  570       CONTINUE
-            DO 580 JJ = 1,NCOL - JMAX
-              JA1 = JA1 + 1
-              J1 = J1 + 1
-              SWOP = A(JA1)
-              A(JA1) = A(J1)
-              A(J1) = SWOP
-  580       CONTINUE
-            SWOP = A(APOS+ (NUMPVT+NPIVD2)* (NFRONT+1))
-            A(APOS+ (NUMPVT+NPIVD2)* (NFRONT+1)) = A(APOS+
-     +        (JMAX-1)* (NFRONT+1))
-            A(APOS+ (JMAX-1)* (NFRONT+1)) = SWOP
-            IPOS = IWPOS + NUMPVT + NPIVD2
-            IEXCH = IWPOS + JMAX - 1
-            ISWOP = IW(IPOS)
-            IW(IPOS) = IW(IEXCH)
-            IW(IEXCH) = ISWOP
-  590       POSPV1 = APOS + NPIVD2* (NFRONT+1)
-            POSPV2 = APOS + (NUMPVT+NPIVD2)* (NFRONT+1)
-            OFFDAG = POSPV1 + NUMPVT
-            FLOPSB = FLOPSB + 3.0
-            NEIG = NEIG + 1
-C?? We could decide not to swop these over.
-C?? Also could save if pivot was oxo.
-            A(POSPV1) = A(POSPV2)/DETPIV
-            A(POSPV2) = ZERO
-            A(OFFDAG) = -A(OFFDAG)/DETPIV
-            J1 = OFFDAG + NFRONT
-            J2 = OFFDAG + (NUMPVT-NPIVD2-1)*NFRONT
-            IBEG = J1 + 1
-            IEND = APOS + (NPIVD2+1)*NFRONT + NCOL - 1
-            DO 610 JJ = J1,J2,NFRONT
-              AMULT1 = - (A(JJ)*A(OFFDAG))
-              FLOPSB = FLOPSB + (IEND-IBEG+1)*2 + 1
-              K1 = OFFDAG + 1
-CDIR$            IVDEP
-              DO 600 IROW = IBEG,IEND
-                A(IROW) = A(IROW) + AMULT1*A(K1)
-                K1 = K1 + 1
-  600         CONTINUE
-              A(JJ) = -AMULT1
-              IBEG = IBEG + NFRONT
-              IEND = IEND + NFRONT
-  610       CONTINUE
-            J1 = POSPV2 + 1
-            J2 = POSPV2 + NASS - NUMPVT - NPIVD2 - 1
-            IBEG = J1 + NFRONT
-            IEND = APOS + (NUMPVT+NPIVD2+2)*NFRONT - 1
-            DO 630 JJ = J1,J2
-              AMULT1 = - (A(JJ-NUMPVT*NFRONT)*A(POSPV1)+A(JJ)*A(OFFDAG))
-              AMULT2 = - (A(JJ-NUMPVT*NFRONT)*A(OFFDAG))
-              FLOPSB = FLOPSB + (IEND-IBEG+2)*4
-              K1 = JJ - NFRONT*NUMPVT
-              K2 = JJ
-CDIR$            IVDEP
-              DO 620 IROW = IBEG,IEND
-                A(IROW) = A(IROW) + AMULT1*A(K1) + AMULT2*A(K2)
-                K1 = K1 + 1
-                K2 = K2 + 1
-  620         CONTINUE
-              IF (JJ.LE.POSPV2+NUMPVT-NPIVD2-1) THEN
-                A(JJ-NUMPVT*NFRONT) = -AMULT2
-                A(JJ) = AMULT1
-              ELSE
-                A(JJ-NUMPVT*NFRONT) = AMULT1
-                A(JJ) = AMULT2
-              END IF
-              IBEG = IBEG + NFRONT + 1
-              IEND = IEND + NFRONT
-  630       CONTINUE
-            IW(IWPOS+NUMPVT+NPIVD2) = -IW(IWPOS+NUMPVT+NPIVD2)
-            IW(IWPOS+NPIVD2) = -IW(IWPOS+NPIVD2)
-            NPIV = NPIV + 2
-            NPIVD2 = NPIVD2 + 1
-            NTOTPV = NTOTPV + 2
-            IF (KIND.EQ.3) NOXOB = NOXOB + 1
-            IF (KIND.EQ.2) NTILEB = NTILEB + 1
-            NSTRUC = NSTRUC + 2
-  640     CONTINUE
-          IF (LNPIV.EQ.NPIV) GO TO 660
-  650   CONTINUE
-  660   IF (NPIV.EQ.NASS) GO TO 930
-        IF (NPIV.EQ.NUMORG .OR. NPIV.EQ.0) GO TO 750
-        DO 680 I = 1,NPIVD2
-          JA1 = APOS + NUMPVT + NPIVD2 + (I-1)*NFRONT
-          DO 670 J = 1,NUMPVT - NPIVD2
-            A(JA1) = -A(JA1)
-            JA1 = JA1 + 1
-  670     CONTINUE
-  680   CONTINUE
-        DO 700 I = 1,NUMPVT - NPIVD2
-          JA1 = APOS + NPIVD2*NFRONT + NUMPVT + (I-1)*NFRONT
-          DO 690 J = 1,NPIVD2
-            A(JA1) = -A(JA1)
-            JA1 = JA1 + 1
-  690     CONTINUE
-  700   CONTINUE
-        CALL MA47YD(A(APOS+NPIVD2),NFRONT,NPIVD2,NUMPVT-NPIVD2,
-     +              A(APOS+NUMPVT*NFRONT),NFRONT,.FALSE.,.FALSE.)
-        CALL MA47YD(A(APOS+NUMPVT),NFRONT,NPIVD2,NPIVD2,A(APOS+NPIVD2),
-     +              NFRONT,.FALSE.,.FALSE.)
-        CALL MA47YD(A(APOS+NUMPVT*NFRONT),NFRONT,NPIVD2,NUMPVT-NPIVD2,
-     +              A(APOS+NPIV),NFRONT,.FALSE.,.FALSE.)
-        CALL MA47YD(A(APOS+NPIVD2*NFRONT+NUMPVT),NFRONT,NUMPVT-NPIVD2,
-     +              NPIVD2,A(APOS+NUMPVT*NFRONT),NFRONT,.FALSE.,.FALSE.)
-        CALL MA47YD(A(APOS+NUMPVT* (NFRONT+1)),NFRONT,NPIVD2,NPIVD2,
-     +              A(APOS+NPIVD2* (NFRONT+1)),NFRONT,.TRUE.,.FALSE.)
-        CALL MA47XD(A(APOS+NPIV* (NFRONT+1)),NFRONT,NUMPVT-NPIVD2,
-     +              NUMPVT-NPIVD2)
-        CALL MA47YD(A(APOS+NUMPVT*NFRONT),NFRONT,NUMPVT-NPIVD2,NPIVD2,
-     +              A(APOS+NPIVD2*NFRONT+NPIV),NFRONT,.FALSE.,.TRUE.)
-        ATRASH = (NUMPVT-NPIVD2)* (NFRONT-NUMPVT-NPIVD2)
-        RLSPA = MAX(RLSPA,INFO(2)+APOS+NFRONT*NASS+ATRASH+NSTKAC(1))
-        IF (APOS+NASS*NFRONT+ATRASH.GT.ASTK) THEN
-          CALL MA47SD(A,ASTK,PTRA,AINPUT,NCMPBR)
-          IF (APOS+NASS*NFRONT+ATRASH.GT.ASTK) THEN
-            INFO(2) = INFO(2) + APOS - 1
-            DO 710 I = 1,NASS*NFRONT
-              A(I) = A(APOS+I-1)
-  710       CONTINUE
-            APOS = 1
-            APOSBB = 1
-            INFO(1) = -4
-            IF (NFRONT*NASS+ATRASH.GT.ASTK) THEN
-              INFO(2) = RLSPA
-              GO TO 2170
-            END IF
-          END IF
-        END IF
-        ASTK = ASTK - ATRASH
-        CALL MA47YD(A(APOS+NPIVD2*NFRONT+NPIVD2+NUMPVT),NFRONT,
-     +              NUMPVT-NPIVD2,NFRONT-NUMPVT-NPIVD2,A(ASTK),
-     +              NFRONT-NUMPVT-NPIVD2,.FALSE.,.FALSE.)
-        CALL MA47YD(A(APOS+NUMPVT*NFRONT+NPIVD2+NUMPVT),NFRONT,NPIVD2,
-     +              NFRONT-NUMPVT-NPIVD2,A(APOS+NPIVD2*NFRONT+NPIVD2+
-     +              NUMPVT),NFRONT,.FALSE.,.FALSE.)
-        CALL MA47YD(A(ASTK),NFRONT-NUMPVT-NPIVD2,NUMPVT-NPIVD2,
-     +              NFRONT-NUMPVT-NPIVD2,A(APOS+NPIV*NFRONT+NPIVD2+
-     +              NUMPVT),NFRONT,.FALSE.,.FALSE.)
-        ASTK = ASTK + ATRASH
-        CALL MA47YD(A(APOS+NPIV),NFRONT,NPIVD2,2* (NUMPVT-NPIVD2),
-     +              A(APOS+NPIV*NFRONT),NFRONT,.FALSE.,.TRUE.)
-        CALL MA47YD(A(APOS+NPIVD2*NFRONT+NPIV),NFRONT,NPIVD2,
-     +              2* (NUMPVT-NPIVD2),A(APOS+NPIV),NFRONT,.FALSE.,
-     +              .FALSE.)
-        CALL MA47YD(A(APOS+NPIV*NFRONT),NFRONT,2* (NUMPVT-NPIVD2),
-     +              NPIVD2,A(APOS+NPIVD2*NFRONT+NPIV),NFRONT,.FALSE.,
-     +              .TRUE.)
-        J1 = IWPOS + N - NTOTPV + NPIV
-        DO 720 JJ = NPIVD2,NUMPVT - 1
-          IW(J1) = IW(IWPOS+JJ)
-          J1 = J1 + 1
-  720   CONTINUE
-        J1 = IWPOS + NPIVD2
-        DO 730 JJ = NUMPVT,NUMPVT + NPIVD2 - 1
-          IW(J1) = IW(IWPOS+JJ)
-          J1 = J1 + 1
-  730   CONTINUE
-        DO 740 JJ = 1,NUMPVT - NPIVD2
-          IW(J1) = IW(IWPOS+N-NTOTPV+NPIV+JJ-1)
-          J1 = J1 + 1
-  740   CONTINUE
-  750   NCOL = NFRONT
-  760   MA1 = (NCOL-NPIV-1)**2
-        IF (FATHER(IASS).NE.NODES+1) THEN
-        END IF
-        DO 920 KSWEEP = 1,NASS - NPIV
-          NNULL = 0
-          LNPIV = NPIV
-          JPIV = 1
-          DO 910 IPIV = NPIV + 1,NASS
-            JPIV = JPIV - 1
-            IF (JPIV.EQ.1) GO TO 910
-            IF (IPIV.GT.NUMORG) NCOL = NFRONT
-            APOSI = APOS + (IPIV-1)*NFRONT
-            POSPV1 = APOSI + IPIV - 1
-            PIVOT = A(POSPV1)
-            IF (MA1.EQ.0) THEN
-              IF (ABS(PIVOT).GT.TOL) THEN
-                PIVSIZ = 1
-                JMAX = IPIV
-                GO TO 810
-              END IF
-            END IF
-            A(POSPV1) = ZERO
-            J1MAX = NPIV + IDAMAX(IPIV-NPIV,A(APOS+NPIV*NFRONT+IPIV-1),
-     +              NFRONT)
-            A1MAX = ABS(A(APOS+IPIV-1+ (J1MAX-1)*NFRONT))
-            JMAX = IPIV - 1 + IDAMAX(NASS-IPIV+1,A(POSPV1),1)
-            AMAX = ABS(A(APOSI+JMAX-1))
-            IF (A1MAX.GT.AMAX) THEN
-              AMAX = A1MAX
-              JMAX = J1MAX
-            END IF
-            IF (NASS.EQ.NFRONT) THEN
-              RMAX = ZERO
-            ELSE
-              JJ = IDAMAX(NFRONT-NASS,A(APOSI+NASS),1)
-              RMAX = ABS(A(APOSI+NASS+JJ-1))
-            END IF
-            IF (MAX(AMAX,RMAX,ABS(PIVOT)).LE.TOL) THEN
-              NNULL = NNULL + 1
-              GO TO 910
-            END IF
-            IF (MAX(AMAX,ABS(PIVOT)).LE.TOL) GO TO 910
-            PIVSIZ = 0
-            IF (ABS(PIVOT).GT.UU*MAX(RMAX,AMAX)) THEN
-              PIVSIZ = 1
-              A(POSPV1) = PIVOT
-              GO TO 810
-            END IF
-            IF (NPIV+1.EQ.NASS) THEN
-              A(POSPV1) = PIVOT
-              GO TO 910
-            END IF
-            IF (RMAX.LT.AMAX) THEN
-              AMULT1 = A(APOSI+JMAX-1)
-              A(APOSI+JMAX-1) = ZERO
-              J1MAX = NPIV + IDAMAX(IPIV-NPIV,
-     +                A(APOS+NPIV*NFRONT+IPIV-1),NFRONT)
-              A1MAX = ABS(A(APOS+IPIV-1+ (J1MAX-1)*NFRONT))
-              J1MAX = IPIV - 1 + IDAMAX(NASS-IPIV+1,A(POSPV1),1)
-              RMAX = MAX(RMAX,A1MAX,ABS(A(APOSI+J1MAX-1)))
-              A(APOSI+JMAX-1) = AMULT1
-            END IF
-            APOSJ = APOS + (JMAX-1)*NFRONT
-            IF (JMAX.GT.NUMORG) NCOL = NFRONT
-            POSPV2 = APOSJ + JMAX - 1
-            IF (IPIV.GT.JMAX) THEN
-              OFFDAG = APOSJ + IPIV - 1
-            ELSE
-              OFFDAG = APOSI + JMAX - 1
-            END IF
-            AMULT1 = A(OFFDAG)
-            A(OFFDAG) = ZERO
-            AMULT2 = A(POSPV2)
-            A(POSPV2) = ZERO
-            J1MAX = NPIV + IDAMAX(JMAX-NPIV,A(APOS+NPIV*NFRONT+JMAX-1),
-     +              NFRONT)
-            TMAX = ABS(A(APOS+JMAX-1+ (J1MAX-1)*NFRONT))
-            J1MAX = JMAX - 1 + IDAMAX(NCOL-JMAX+1,A(POSPV2),1)
-            TMAX = MAX(TMAX,ABS(A(APOSJ+J1MAX-1)))
-            A(OFFDAG) = AMULT1
-            A(POSPV2) = AMULT2
-            A(POSPV1) = PIVOT
-            DETPIV = A(POSPV1)*A(POSPV2) - AMAX*AMAX
-            MAXPIV = MAX(ABS(A(POSPV1)),ABS(A(POSPV2)))
-            IF (MAXPIV.EQ.ZERO) MAXPIV = ONE
-            IF (ABS(DETPIV)/MAXPIV.LE.TOL) GO TO 910
-            PIVSIZ = 2
-            IF ((ABS(A(POSPV2))*RMAX+AMAX*TMAX)*UU.GT.
-     +          ABS(DETPIV)) GO TO 770
-            IF ((ABS(A(POSPV1))*TMAX+AMAX*RMAX)*UU.GT.
-     +          ABS(DETPIV)) GO TO 770
-            GO TO 810
-  770       IF (ABS(A(POSPV2)).LT.UU*MAX(AMAX,TMAX)) GO TO 910
-            IF (ABS(A(POSPV2)).LE.TOL) GO TO 910
-            TMAX = ZERO
-            AMULT2 = - (A(OFFDAG)/A(POSPV2))
-            JA1 = APOS + (JMAX-1) + NPIV*NFRONT
-            JA2 = APOS + (IPIV-1) + NPIV*NFRONT
-            DO 780 J = NPIV + 1,MIN(IPIV,JMAX) - 1
-              TMAX = MAX(TMAX,ABS(A(JA2)+A(JA1)*AMULT2))
-              JA1 = JA1 + NFRONT
-              JA2 = JA2 + NFRONT
-  780       CONTINUE
-            IF (JMAX.GT.IPIV) THEN
-              J1 = NFRONT
-              J2 = 1
-              JA1 = APOS + IPIV*NFRONT + JMAX - 1
-              JA2 = APOS + (IPIV-1)*NFRONT + IPIV
-            ELSE
-              J1 = 1
-              J2 = NFRONT
-              JA1 = APOS + (JMAX-1)*NFRONT + JMAX
-              JA2 = APOS + JMAX*NFRONT + IPIV - 1
-            END IF
-            DO 790 J = MIN(IPIV,JMAX) + 1,MAX(IPIV,JMAX) - 1
-              TMAX = MAX(TMAX,ABS(A(JA2)+A(JA1)*AMULT2))
-              JA1 = JA1 + J1
-              JA2 = JA2 + J2
-  790       CONTINUE
-            JA1 = APOS + (JMAX-1)*NFRONT + JMAX
-            JA2 = APOS + (IPIV-1)*NFRONT + JMAX
-            DO 800 J = MAX(IPIV,JMAX) + 1,NCOL
-              TMAX = MAX(TMAX,ABS(A(JA2)+A(JA1)*AMULT2))
-              JA1 = JA1 + 1
-              JA2 = JA2 + 1
-  800       CONTINUE
-            IF (ABS(DETPIV/A(POSPV2)).LT.UU*TMAX) GO TO 910
-  810       LPIV = IPIV
-            IF (PIVSIZ.EQ.2) LPIV = MIN(IPIV,JMAX)
-            DO 860 KROW = NPIV,NPIV + PIVSIZ - 1
-              IF (LPIV.EQ.KROW+1) GO TO 850
-              JA1 = APOS + (LPIV-1)
-              J1 = APOS + KROW
-              DO 820 JJ = 1,KROW
-                SWOP = A(JA1)
-                A(JA1) = A(J1)
-                A(J1) = SWOP
-                JA1 = JA1 + NFRONT
-                J1 = J1 + NFRONT
-  820         CONTINUE
-              JA1 = JA1 + NFRONT
-              J1 = J1 + 1
-              DO 830 JJ = 1,LPIV - KROW - 2
-                SWOP = A(JA1)
-                A(JA1) = A(J1)
-                A(J1) = SWOP
-                JA1 = JA1 + NFRONT
-                J1 = J1 + 1
-  830         CONTINUE
-              SWOP = A(APOS+KROW* (NFRONT+1))
-              A(APOS+KROW* (NFRONT+1)) = A(JA1)
-              A(JA1) = SWOP
-              DO 840 JJ = 1,NCOL - LPIV
-                JA1 = JA1 + 1
-                J1 = J1 + 1
-                SWOP = A(JA1)
-                A(JA1) = A(J1)
-                A(J1) = SWOP
-  840         CONTINUE
-              IPOS = IWPOS + KROW
-              IEXCH = IWPOS + LPIV - 1
-              ISWOP = IW(IPOS)
-              IW(IPOS) = IW(IEXCH)
-              IW(IEXCH) = ISWOP
-  850         LPIV = MAX(IPIV,JMAX)
-  860       CONTINUE
-            POSPV1 = APOS + NPIV* (NFRONT+1)
-            POSPV2 = POSPV1 + NFRONT + 1
-            IF (PIVSIZ.EQ.1) THEN
-              FLOPSB = FLOPSB + ONE
-              A(POSPV1) = ONE/A(POSPV1)
-              IF (A(POSPV1).LT.ZERO) NEIG = NEIG + 1
-              J1 = POSPV1 + 1
-              J2 = POSPV1 + NASS - (NPIV+1)
-              IBEG = POSPV1 + NFRONT + 1
-              IEND = APOS + (NPIV+1)*NFRONT + NCOL - 1
-              DO 880 JJ = J1,J2
-                AMULT1 = -A(JJ)*A(POSPV1)
-                JCOL = JJ
-                FLOPSB = FLOPSB + (IEND-IBEG+1)*2 + 1
-CDIR$            IVDEP
-                DO 870 IROW = IBEG,IEND
-                  A(IROW) = A(IROW) + AMULT1*A(JCOL)
-                  JCOL = JCOL + 1
-  870           CONTINUE
-                A(JJ) = AMULT1
-                IBEG = IBEG + NFRONT + 1
-                IEND = IEND + NFRONT
-  880         CONTINUE
-              NPIV = NPIV + 1
-              NTOTPV = NTOTPV + 1
-              JPIV = 1
-            ELSE
-              OFFDAG = POSPV1 + 1
-              FLOPSB = FLOPSB + 6.0
-              SWOP = A(POSPV2)
-              IF (DETPIV.LT.ZERO) THEN
-                NEIG = NEIG + 1
-              ELSE
-                IF (SWOP.LT.ZERO) NEIG = NEIG + 2
-              END IF
-              A(POSPV2) = A(POSPV1)/DETPIV
-              A(POSPV1) = SWOP/DETPIV
-              A(OFFDAG) = -A(OFFDAG)/DETPIV
-              J1 = POSPV1 + 2
-              J2 = POSPV1 + NASS - (NPIV+1)
-              IBEG = POSPV2 + NFRONT + 1
-              IEND = APOS + (NPIV+2)*NFRONT + NCOL - 1
-              DO 900 JJ = J1,J2
-                K1 = JJ
-                K2 = JJ + NFRONT
-                AMULT1 = - (A(POSPV1)*A(K1)+A(POSPV1+1)*A(K2))
-                AMULT2 = - (A(POSPV1+1)*A(K1)+A(POSPV2)*A(K2))
-                FLOPSB = FLOPSB + (IEND-IBEG+1)*4 + 6
-CDIR$            IVDEP
-                DO 890 IROW = IBEG,IEND
-                  A(IROW) = A(IROW) + AMULT1*A(K1) + AMULT2*A(K2)
-                  K1 = K1 + 1
-                  K2 = K2 + 1
-  890           CONTINUE
-                A(JJ) = AMULT1
-                A(JJ+NFRONT) = AMULT2
-                IBEG = IBEG + NFRONT + 1
-                IEND = IEND + NFRONT
-  900         CONTINUE
-              IPOS = IWPOS + NPIV
-              IW(IPOS) = -IW(IPOS)
-              IW(IPOS+1) = -IW(IPOS+1)
-              NPIV = NPIV + 2
-              NTOTPV = NTOTPV + 2
-              NFULLB = NFULLB + 1
-              JPIV = 2
-            END IF
-  910     CONTINUE
-          IF (LNPIV.EQ.NPIV) GO TO 930
-  920   CONTINUE
-  930   IF (NPIV.EQ.0) GO TO 1730
-        NOSURE = (NBLOC.GE. (NCOL-NASS)) .AND. (NSTRUC.EQ.0)
-        ZONE = ZERO
-        IF (NSTRUC.GT.0 .AND. NPIV.NE.NSTRUC) ZONE = ONE
-        NUM1 = 0
-        NUM2 = 0
-        NUM3 = 0
-        IF (NPIV.EQ.NFRONT) GO TO 1830
-        IF (NSTRUC.GT.0) THEN
-          J2 = NCOL
-          DO 1000 J1 = NASS + 1,NCOL
-            JA1 = APOS + J1 - 1
-            DO 940 K = 1,NSTRUC/2
-              IF (A(JA1).NE.ZERO) GO TO 990
-              JA1 = JA1 + NFRONT
-  940       CONTINUE
-            DO 960 JJ = J2,J1 + 1,-1
-              JA2 = APOS + JJ - 1
-              DO 950 K = 1,NSTRUC/2
-                IF (A(JA2).NE.ZERO) THEN
-                  J2 = JJ
-                  GO TO 970
-                END IF
-                JA2 = JA2 + NFRONT
-  950         CONTINUE
-  960       CONTINUE
-            J2 = J1 - 1
-            GO TO 1010
-  970       ISWOP = IW(IWPOS-1+J1)
-            IW(IWPOS-1+J1) = IW(IWPOS-1+J2)
-            IW(IWPOS-1+J2) = ISWOP
-            PPOS(ISWOP) = J2
-            PPOS(IW(IWPOS-1+J1)) = J1
-            JA1 = APOS + J1 - 1
-            JA2 = APOS + J2 - 1
-            DO 980 LDUMMY = 1,NASS
-              SWOP = A(JA1)
-              A(JA1) = A(JA2)
-              A(JA2) = SWOP
-              JA1 = JA1 + NFRONT
-              JA2 = JA2 + NFRONT
-  980       CONTINUE
-            J2 = J2 - 1
-  990       IF (J1.GE.J2) GO TO 1010
- 1000     CONTINUE
- 1010     NUM1 = 0
-          NUM2 = J2 - NASS
-          NUM3 = NCOL - J2
-          IF (KIND.EQ.3) THEN
-            DO 1090 J1 = NASS + 1,NASS + NUM2
-              JA1 = APOS + (NSTRUC/2)*NFRONT + J1 - 1
-              DO 1020 K = 1,NSTRUC/2
-                IF (A(JA1).NE.ZERO) GO TO 1030
-                JA1 = JA1 + NFRONT
- 1020         CONTINUE
-              GO TO 1080
- 1030         DO 1050 JJ = J2,J1 + 1,-1
-                JA2 = APOS + (NSTRUC/2)*NFRONT + JJ - 1
-                DO 1040 K = 1,NSTRUC/2
-                  IF (A(JA2).NE.ZERO) GO TO 1050
-                  JA2 = JA2 + NFRONT
- 1040           CONTINUE
-                J2 = JJ
-                GO TO 1060
- 1050         CONTINUE
-              J2 = J1 - 1
-              GO TO 1100
- 1060         ISWOP = IW(IWPOS-1+J1)
-              IW(IWPOS-1+J1) = IW(IWPOS-1+J2)
-              IW(IWPOS-1+J2) = ISWOP
-              PPOS(ISWOP) = J2
-              PPOS(IW(IWPOS-1+J1)) = J1
-              JA1 = APOS + J1 - 1
-              JA2 = APOS + J2 - 1
-              DO 1070 LDUMMY = 1,NASS
-                SWOP = A(JA1)
-                A(JA1) = A(JA2)
-                A(JA2) = SWOP
-                JA1 = JA1 + NFRONT
-                JA2 = JA2 + NFRONT
- 1070         CONTINUE
-              J2 = J2 - 1
- 1080         IF (J1.GE.J2) GO TO 1100
- 1090       CONTINUE
- 1100       NUM1 = J2 - NASS
-            NUM2 = NUM2 - NUM1
-          END IF
-        END IF
-        ZCOL = 0
-        APOS1 = APOS + NCOL - 1
-        APOS2 = APOS + NCOL
-        DO 1140 J = 1,NCOL - (NUM1+NUM2+NASS)
-          DO 1110 JA1 = 1,NPIV
-            IF (A(APOS1+ (JA1-1)*NFRONT).NE.ZERO) GO TO 1130
- 1110     CONTINUE
-          ZCOL = ZCOL + 1
-          APOS2 = APOS2 - 1
-          IF (APOS1.EQ.APOS2) GO TO 1130
-          DO 1120 JA1 = 1,NASS
-            SWOP = A(APOS1+ (JA1-1)*NFRONT)
-            A(APOS1+ (JA1-1)*NFRONT) = A(APOS2+ (JA1-1)*NFRONT)
-            A(APOS2+ (JA1-1)*NFRONT) = SWOP
- 1120     CONTINUE
-          ISWOP = IW(IWPOS+APOS2-APOS)
-          IW(IWPOS+APOS2-APOS) = IW(IWPOS+APOS1-APOS)
-          IW(IWPOS+APOS1-APOS) = ISWOP
-          PPOS(ISWOP) = APOS1 - APOS + 1
-          PPOS(IW(IWPOS+APOS2-APOS)) = APOS2 - APOS + 1
- 1130     APOS1 = APOS1 - 1
- 1140   CONTINUE
-        NCOL = NCOL - ZCOL
-        NUM3 = NUM3 - ZCOL
-        IF (NCOL.EQ.NASS) GO TO 1730
-        APOS3 = APOS + NFRONT*NASS
-        IF (NPIV.EQ.NSTRUC) THEN
-          NSC1 = NUM1 + NUM2
-          NSC2 = NUM2 + NUM3
-          IF (NSC1*NSC2.EQ.0) THEN
-            APOSI = APOS + NASS
-            OFFDAG = APOS + NSTRUC/2
-            FLOPSB = FLOPSB + (NUM1+NUM3)*NSTRUC/2
-            DO 1170 K = 1,NSTRUC/2
-              DO 1150 JJ = APOSI,APOSI + NUM1 - 1
-                A(JJ+NFRONT*NSTRUC/2) = -A(OFFDAG)*A(JJ)
-                A(JJ) = ZERO
- 1150         CONTINUE
-              DO 1160 JJ = APOSI + NUM1,APOSI + NUM1 + NUM3 - 1
-                A(JJ) = - (A(OFFDAG)*A(JJ+NFRONT*NSTRUC/2))
-                A(JJ+NFRONT*NSTRUC/2) = ZERO
- 1160         CONTINUE
-              APOSI = APOSI + NFRONT
-              OFFDAG = OFFDAG + NFRONT + 1
- 1170       CONTINUE
-            GO TO 1730
-          END IF
-        ELSE
-          NSC1 = NCOL - NASS
-          NSC2 = NCOL - NASS
-        END IF
-        IF (NOSURE) THEN
-C
-          APOS4 = ASTK - ((NSC1+1)*NSC1)/2 - 1
-          RLSPA = MAX(RLSPA,INFO(2)+APOS3+ ((NSC1+1)*NSC1)/2+2+
-     +            NSTKAC(1))
-          IF (APOS3.GT.APOS4) THEN
-            CALL MA47SD(A,ASTK,PTRA,AINPUT,NCMPBR)
-C
-            APOS4 = ASTK - ((NSC1+1)*NSC1)/2 - 1
-            IF (APOS3.GT.APOS4) THEN
-              INFO(2) = INFO(2) + APOS - 1
-              DO 1180 I = 1,NASS*NFRONT
-                A(I) = A(APOS+I-1)
- 1180         CONTINUE
-              APOSBB = 1
-              APOS = 1
-              APOS3 = APOS + NFRONT*NASS
-              INFO(1) = -4
-              IF (APOS3.GT.APOS4) THEN
-                INFO(2) = RLSPA
-                GO TO 2170
-              END IF
-            END IF
-          END IF
-          A(ASTK) = ((NSC1+1)*NSC1)/2 + 2
-          A(APOS4) = ((NSC1+1)*NSC1)/2 + 2
-          NSTKAC(1) = NSTKAC(1) + ((NSC1+1)*NSC1)/2 + 2
-        ELSE
-          APOS4 = APOS3 + NPIV*NSC2
-          IF (NPIV.EQ.NSTRUC) THEN
-            NSCHUR = MAX(NSC1*NSC2+1,NUM1* (NUM2+NUM3)+NUM2*NUM3+
-     +               (NUM2* (NUM2+1))/2+2)
-          ELSE
-            NSCHUR = MAX(NSC1*NSC2+1, (NSC1* (NSC1+1))/2+2)
-          END IF
-          RLSPA = MAX(RLSPA,INFO(2)+APOS4+NSCHUR+NSTKAC(1))
-          IF (APOS4+NSCHUR-1.GT.ASTK) THEN
-            CALL MA47SD(A,ASTK,PTRA,AINPUT,NCMPBR)
-            IF (APOS4+NSCHUR-1.GT.ASTK) THEN
-              INFO(2) = INFO(2) + APOS - 1
-              DO 1190 I = 1,NASS*NFRONT
-                A(I) = A(APOS+I-1)
- 1190         CONTINUE
-              APOSBB = 1
-              APOS = 1
-              APOS3 = APOS + NFRONT*NASS
-              INFO(1) = -4
-              APOS4 = APOS3 + NPIV*NSC2
-              IF (APOS4+NSCHUR-1.GT.ASTK) THEN
-                INFO(2) = RLSPA
-                GO TO 2170
-              END IF
-            END IF
-          END IF
-          IF (ZONE.EQ.ONE) THEN
-            DO 1200 K = APOS4,APOS4 + NSC1*NSC2 - 1
-              A(K) = ZERO
- 1200       CONTINUE
-          END IF
-        END IF
-        IF (NSTRUC.GT.0) THEN
-          POSPV1 = APOS
-          APOSI = APOS
-          OFFDAG = POSPV1 + NSTRUC/2
-          FLOPSB = FLOPSB + (NUM1+4*NUM2+NUM3)*NSTRUC/2
-          DO 1240 K = 1,NSTRUC/2
-            DO 1210 JJ = APOSI + NASS,APOSI + NASS + NUM1 - 1
-              A(JJ+NFRONT*NSTRUC/2) = -A(OFFDAG)*A(JJ)
-              A(JJ) = ZERO
- 1210       CONTINUE
-            APOS2 = APOS3 + (K-1)* (NUM2+NUM3)
-            DO 1220 JJ = APOSI + NASS + NUM1,
-     +             APOSI + NASS + NUM1 + NUM2 - 1
-              A(APOS2) = A(JJ)
-              A(APOS2+ (NSTRUC/2)* (NUM2+NUM3)) = A(JJ+NFRONT*NSTRUC/2)
-              A(JJ) = - (A(POSPV1)*A(JJ)+A(OFFDAG)*
-     +                A(JJ+NFRONT*NSTRUC/2))
-              A(JJ+NFRONT*NSTRUC/2) = -A(OFFDAG)*A(APOS2)
-              APOS2 = APOS2 + 1
- 1220       CONTINUE
-            APOS2 = APOS3 + (K-1)* (NUM2+NUM3) + NUM2
-            DO 1230 JJ = APOSI + NASS + NUM1 + NUM2,APOSI + NCOL - 1
-              A(APOS2) = ZERO
-              A(APOS2+ (NSTRUC/2)* (NUM2+NUM3)) = A(JJ+NFRONT*NSTRUC/2)
-              A(JJ) = - (A(OFFDAG)*A(JJ+NFRONT*NSTRUC/2))
-              A(JJ+NFRONT*NSTRUC/2) = ZERO
-              APOS2 = APOS2 + 1
- 1230       CONTINUE
-            POSPV1 = POSPV1 + NFRONT + 1
-            APOSI = APOSI + NFRONT
-            OFFDAG = OFFDAG + NFRONT + 1
- 1240     CONTINUE
-          IF (NPIV.EQ.NSTRUC) THEN
-            APOS1 = APOS4
-          ELSE
-            APOS1 = APOS4 + NUM1
-          END IF
-          FLOPSB = FLOPSB + 2*NSTRUC*NUM1* (NUM2+NUM3)
-          IF (NUM1.GE.NBLOC) THEN
-            CALL DGEMM('N','T',NUM2+NUM3,NUM1,NSTRUC,ONE,A(APOS3),
-     +                 NUM2+NUM3,A(APOS+NASS),NFRONT,ZERO,A(APOS1),NSC2)
-          ELSE
-            APOSI = APOS
-            DO 1280 K = 1,NSTRUC/2
-              INC = NSC2
-              JA1 = APOS1
-              J1 = APOSI + NASS + NFRONT*NSTRUC/2
-              DO 1270 JJ = 1,NUM1
-                AMULT2 = A(J1)
-                J1 = J1 + 1
-                K2 = APOS3 + (K+NSTRUC/2-1)* (NUM2+NUM3)
-                IF (K.EQ.1) THEN
-                  DO 1250 IROW = JA1,JA1 + NUM2 + NUM3 - 1
-                    A(IROW) = AMULT2*A(K2)
-                    K2 = K2 + 1
- 1250             CONTINUE
-                ELSE
-                  DO 1260 IROW = JA1,JA1 + NUM2 + NUM3 - 1
-                    A(IROW) = A(IROW) + AMULT2*A(K2)
-                    K2 = K2 + 1
- 1260             CONTINUE
-                END IF
-                JA1 = JA1 + INC
- 1270         CONTINUE
-              APOSI = APOSI + NFRONT
- 1280       CONTINUE
-          END IF
-          FLOPSB = FLOPSB + NSTRUC* (2*NUM3+NUM2+1)*NUM2
-          FLOPSX = FLOPSX + NSTRUC*NUM2*NUM3
-          APOS1 = APOS1 + NUM1*NSC2
-          JA1 = APOS1
-          KBLK = NUM2/NBLOC
-          DO 1290 K = 1,KBLK
-            JA1 = (K-1)*NBLOC
-            FLOPSX = FLOPSX + NBLOC* (NBLOC-1)*NSTRUC
-            CALL DGEMM('N','T',NUM2+NUM3-JA1,NBLOC,NSTRUC,ONE,
-     +                 A(APOS3+JA1),NUM2+NUM3,A(APOS+NASS+NUM1+JA1),
-     +                 NFRONT,ZERO,A(APOS1+JA1* (NSC2+1)),NSC2)
- 1290     CONTINUE
-          APOSI = APOS
-          APOS1 = APOS1 + KBLK*NBLOC* (NSC2+1)
-          DO 1350 K = 1,NSTRUC/2
-            INC = NSC2
-            JA1 = APOS1
-            JA2 = JA1 + NUM2 - 1 - KBLK*NBLOC
-            J1 = APOSI + NASS + NUM1 + KBLK*NBLOC
-            DO 1340 JJ = 1,NUM2 - KBLK*NBLOC
-              AMULT1 = A(J1)
-              AMULT2 = A(J1+NFRONT*NSTRUC/2)
-              J1 = J1 + 1
-              K1 = APOS3 + KBLK*NBLOC + (K-1)* (NUM2+NUM3) + JJ - 1
-              K2 = K1 + (NSTRUC/2)* (NUM2+NUM3)
-              IF (K.EQ.1) THEN
-                DO 1300 IROW = JA1,JA2
-                  A(IROW) = AMULT1*A(K1) + AMULT2*A(K2)
-                  K1 = K1 + 1
-                  K2 = K2 + 1
- 1300           CONTINUE
-              ELSE
-                DO 1310 IROW = JA1,JA2
-                  A(IROW) = A(IROW) + AMULT1*A(K1) + AMULT2*A(K2)
-                  K1 = K1 + 1
-                  K2 = K2 + 1
- 1310           CONTINUE
-              END IF
-              IF (K.EQ.1) THEN
-                DO 1320 IROW = JA2 + 1,JA2 + NUM3
-                  A(IROW) = AMULT2*A(K2)
-                  K2 = K2 + 1
- 1320           CONTINUE
-              ELSE
-                DO 1330 IROW = JA2 + 1,JA2 + NUM3
-                  A(IROW) = A(IROW) + AMULT2*A(K2)
-                  K2 = K2 + 1
- 1330           CONTINUE
-              END IF
-              JA1 = JA1 + INC + 1
-              JA2 = JA2 + INC
- 1340       CONTINUE
-            APOSI = APOSI + NFRONT
- 1350     CONTINUE
-        END IF
-        IF (NSTRUC.EQ.NPIV) GO TO 1560
-        J1 = IWPOS + NSTRUC
-        LTWO = .FALSE.
-        POSPV1 = APOS + NFRONT*NSTRUC + NSTRUC
-        IF (NOSURE) THEN
-          I = NSTRUC + 2
-          APOSI = APOS + NSTRUC*NFRONT + NASS
-          J2 = APOS + NFRONT*NSTRUC + NCOL - 1
-          APOSC = APOS4 + 1
-          IF (IW(J1).GT.0) THEN
-            FLOPSB = FLOPSB + (NCOL-NASS) + (NCOL-NASS)* (NCOL-NASS+1)
-            DO 1370 JJ = APOSI,J2
-              AMULT1 = -A(JJ)*A(POSPV1)
-              DO 1360 JJJ = JJ,J2
-                A(APOSC) = AMULT1*A(JJJ)
-                APOSC = APOSC + 1
- 1360         CONTINUE
-              A(JJ) = AMULT1
- 1370       CONTINUE
-            J1 = J1 + 1
-          ELSE
-            POSPV2 = POSPV1 + NFRONT + 1
-            OFFDAG = POSPV1 + 1
-            FLOPSB = FLOPSB + 6* (NCOL-NASS) +
-     +               2* (NCOL-NASS)* (NCOL-NASS+1)
-            DO 1390 JJ = APOSI,J2
-              AMULT1 = - (A(POSPV1)*A(JJ)+A(OFFDAG)*A(JJ+NFRONT))
-              AMULT2 = -A(POSPV2)*A(JJ+NFRONT) - A(OFFDAG)*A(JJ)
-              DO 1380 JJJ = JJ,J2
-                A(APOSC) = AMULT1*A(JJJ) + AMULT2*A(JJJ+NFRONT)
-                APOSC = APOSC + 1
- 1380         CONTINUE
-              A(JJ) = AMULT1
-              A(JJ+NFRONT) = AMULT2
- 1390       CONTINUE
-            J1 = J1 + 2
-            POSPV1 = POSPV2
-            I = I + 1
-          END IF
-          POSPV1 = POSPV1 + NFRONT + 1
-          DO 1450 I1 = I,NPIV
-            IF (LTWO) GO TO 1440
-            APOSI = APOS + (I1-1)*NFRONT + NASS
-            J2 = APOS + NFRONT* (I1-1) + NCOL - 1
-            APOSC = APOS4 + 1
-            IF (IW(J1).GT.0) THEN
-              FLOPSB = FLOPSB + (NCOL-NASS) + (NCOL-NASS)* (NCOL-NASS+1)
-              DO 1410 JJ = APOSI,J2
-                AMULT1 = -A(JJ)*A(POSPV1)
-                DO 1400 JJJ = JJ,J2
-                  A(APOSC) = A(APOSC) + AMULT1*A(JJJ)
-                  APOSC = APOSC + 1
- 1400           CONTINUE
-                A(JJ) = AMULT1
- 1410         CONTINUE
-              J1 = J1 + 1
-            ELSE
-              POSPV2 = POSPV1 + NFRONT + 1
-              OFFDAG = POSPV1 + 1
-              FLOPSB = FLOPSB + 6* (NCOL-NASS) +
-     +                 2* (NCOL-NASS)* (NCOL-NASS+1)
-              DO 1430 JJ = APOSI,J2
-                AMULT1 = - (A(POSPV1)*A(JJ)+A(OFFDAG)*A(JJ+NFRONT))
-                AMULT2 = -A(POSPV2)*A(JJ+NFRONT) - A(OFFDAG)*A(JJ)
-                DO 1420 JJJ = JJ,J2
-                  A(APOSC) = A(APOSC) + AMULT1*A(JJJ) +
-     +                       AMULT2*A(JJJ+NFRONT)
-                  APOSC = APOSC + 1
- 1420           CONTINUE
-                A(JJ) = AMULT1
-                A(JJ+NFRONT) = AMULT2
- 1430         CONTINUE
-              J1 = J1 + 2
-              POSPV1 = POSPV2
-              LTWO = .TRUE.
-              GO TO 1450
-            END IF
- 1440       LTWO = .FALSE.
-            POSPV1 = POSPV1 + NFRONT + 1
- 1450     CONTINUE
-        ELSE
-          DO 1490 I = NSTRUC + 1,NPIV
-            IF (LTWO) GO TO 1480
-            APOSI = APOS + (I-1)*NFRONT + NASS
-            POSELT = APOS3 + (I-NSTRUC-1)* (NCOL-NASS)
-            IF (IW(J1).GT.0) THEN
-              FLOPSB = FLOPSB + (NCOL-NASS)
-              DO 1460 JJ = APOSI,APOS + NFRONT* (I-1) + NCOL - 1
-                A(POSELT) = A(JJ)
-                A(JJ) = -A(JJ)*A(POSPV1)
-                POSELT = POSELT + 1
- 1460         CONTINUE
-              J1 = J1 + 1
-            ELSE
-              POSPV2 = POSPV1 + NFRONT + 1
-              OFFDAG = POSPV1 + 1
-              FLOPSB = FLOPSB + 6* (NCOL-NASS)
-              DO 1470 JJ = APOSI,APOS + NFRONT* (I-1) + NCOL - 1
-                A(POSELT) = A(JJ)
-                A(POSELT+NCOL-NASS) = A(JJ+NFRONT)
-                A(JJ) = - (A(POSPV1)*A(JJ)+A(OFFDAG)*A(JJ+NFRONT))
-                A(JJ+NFRONT) = -A(POSPV2)*A(JJ+NFRONT) -
-     +                         A(OFFDAG)*A(POSELT)
-                POSELT = POSELT + 1
- 1470         CONTINUE
-              J1 = J1 + 2
-              POSPV1 = POSPV2
-              LTWO = .TRUE.
-              GO TO 1490
-            END IF
- 1480       LTWO = .FALSE.
-            POSPV1 = POSPV1 + NFRONT + 1
- 1490     CONTINUE
-          FLOPSB = FLOPSB + NPIV* (NCOL-NASS)**2 + NPIV* (NCOL-NASS)
-          KBLK = (NCOL-NASS)/NBLOC
-          IF (NPIV-NSTRUC.LT.NBLOC) KBLK = 0
-          APOSH = APOS + NSTRUC*NFRONT
-          L = NCOL - NASS
-          DO 1500 KR = 1,KBLK
-            FLOPSX = FLOPSX + NBLOC* (NBLOC-1)* (NPIV-NSTRUC)
-            CALL DGEMM('N','T',L- (KR-1)*NBLOC,NBLOC,NPIV-NSTRUC,ONE,
-     +                 A(APOSH+NASS+NBLOC* (KR-1)),NFRONT,
-     +                 A(APOS3+NBLOC* (KR-1)),L,ZONE,
-     +                 A(APOS4+NBLOC* (L+1)* (KR-1)),L)
- 1500     CONTINUE
-          DO 1550 I = 1 + KBLK*NBLOC,L
-            APOSA = APOS + NSTRUC*NFRONT + NASS + I - 1
-            APOSB = APOS3 - 1
-            APOSC = APOS4 + (I-1)*L - 1
-            IF (ZONE.EQ.ONE) THEN
-              DO 1510 J = I,L
-                A(APOSC+J) = A(APOSC+J) + A(APOSA)*A(APOSB+J)
- 1510         CONTINUE
-            ELSE
-              DO 1520 J = I,L
-                A(APOSC+J) = A(APOSA)*A(APOSB+J)
- 1520         CONTINUE
-            END IF
-            DO 1540 K = 2,NPIV - NSTRUC
-              APOSA = APOSA + NFRONT
-              APOSB = APOSB + L
-              DO 1530 J = I,L
-                A(APOSC+J) = A(APOSC+J) + A(APOSA)*A(APOSB+J)
- 1530         CONTINUE
- 1540       CONTINUE
- 1550     CONTINUE
-        END IF
- 1560   IF (NCOL.LT.NFRONT) THEN
-          DO 1570 JJ = IWPOS + NCOL,IWPOS + NFRONT - 1
-            J = IW(JJ)
-            PPOS(J) = N + 1
- 1570     CONTINUE
-        END IF
-        IF (NPIV.EQ.NSTRUC) THEN
-          NUMM1 = NUM1
-          NUMM2 = NUM2
-        ELSE
-          NUMM1 = 0
-          NUMM2 = NCOL - NASS
-        END IF
-        NELL = ELEMS(IASS)
-        IELL = ISTK + 1
-        PTRELT = ASTK + 1
-        DO 1650 ELT = 1,NELL
-          IF (NINT(A(PTRELT)).LT.0) PTRELT = PTRELT - NINT(A(PTRELT))
-          IF (IW(IELL).LT.0) IELL = IELL - IW(IELL)
-          IELLN = IELL + IW(IELL)
-          POSELT = PTRELT + NINT(A(PTRELT))
-          JP1 = IELL + 3
-          JP2 = JP1 + IW(IELL+1)
-          JP3 = JP2 + IW(IELL+2)
-          JP4 = IELL + IW(IELL) - 2
-          PPOS(0) = 0
-          DO 1580 JJ = JP2,JP3 - 1
-            IF (IW(JJ).EQ.0) GO TO 1580
-            IF (PPOS(IW(JJ))-NASS.LE.NUMM1 .OR.
-     +          PPOS(IW(JJ))-NASS.GT.NUMM1+NUMM2) GO TO 1640
- 1580     CONTINUE
-          APOS1 = 0
-          DO 1590 JJ = JP1,JP2 - 1
-            IF (IW(JJ).EQ.0) GO TO 1590
-            IF (PPOS(IW(JJ))-NASS.LE.NUMM1) THEN
-              IF (APOS1.EQ.2) GO TO 1640
-              APOS1 = 1
-            END IF
-            IF (PPOS(IW(JJ))-NASS.GT.NUMM1+NUMM2) THEN
-              IF (PPOS(IW(JJ)).EQ.N+1) GO TO 1640
-              IF (APOS1.EQ.1) GO TO 1640
-              APOS1 = 2
-            END IF
- 1590     CONTINUE
-          DO 1600 JJ = JP3,JP4
-            IF (IW(JJ).EQ.0) GO TO 1600
-            IF (PPOS(IW(JJ))-NASS.LE.NUMM1) THEN
-              IF (APOS1.EQ.1) GO TO 1640
-            END IF
-            IF (PPOS(IW(JJ))-NASS.GT.NUMM1+NUMM2) THEN
-              IF (PPOS(IW(JJ)).EQ.N+1) GO TO 1640
-              IF (APOS1.EQ.2) GO TO 1640
-            END IF
- 1600     CONTINUE
-          APOS1 = PTRELT + 1
-          JA2 = JP2
-          DO 1630 JJ = JP1,JP3 - 1
-            J = IW(JJ)
-            IF (J.EQ.0) THEN
-              IF (JJ.LE.JP2) THEN
-                APOS1 = APOS1 + JP4 - JP2 + 1
-              ELSE
-                APOS1 = APOS1 + JP4 - JJ + 1
-              END IF
-              GO TO 1630
-            END IF
-            IF (JJ.GT.JP2) JA2 = JJ
-            IF (NOSURE) THEN
-              DO 1610 JJJ = JA2,JP4
-                JAY = IW(JJJ)
-                IF (PPOS(JAY).GE.PPOS(J)) THEN
-                  APOS2 = APOS4 + 1 + ((PPOS(J)-NASS-1)*
-     +                    (2*NSC2-PPOS(J)+NASS+2))/2 + PPOS(JAY) -
-     +                    PPOS(J)
-                  A(APOS2) = A(APOS2) + A(APOS1)
-                ELSE IF (JAY.GT.0) THEN
-                  APOS2 = APOS4 + 1 + ((PPOS(JAY)-NASS-1)*
-     +                    (2*NSC2-PPOS(JAY)+NASS+2))/2 + PPOS(J) -
-     +                    PPOS(JAY)
-                  A(APOS2) = A(APOS2) + A(APOS1)
-                END IF
-                APOS1 = APOS1 + 1
- 1610         CONTINUE
-            ELSE
-              DO 1620 JJJ = JA2,JP4
-                JAY = IW(JJJ)
-                IF (PPOS(JAY).GE.PPOS(J)) THEN
-                  APOS2 = APOS4 + (PPOS(J)-NASS-1)*NSC2 + PPOS(JAY) -
-     +                    NASS - 1
-                  IF (NSTRUC.EQ.NPIV) APOS2 = APOS2 - NUM1
-                  A(APOS2) = A(APOS2) + A(APOS1)
-                ELSE IF (JAY.GT.0) THEN
-                  APOS2 = APOS4 + (PPOS(JAY)-NASS-1)*NSC2 + PPOS(J) -
-     +                    NASS - 1
-                  IF (NSTRUC.EQ.NPIV) APOS2 = APOS2 - NUM1
-                  A(APOS2) = A(APOS2) + A(APOS1)
-                END IF
-                APOS1 = APOS1 + 1
- 1620         CONTINUE
-            END IF
- 1630     CONTINUE
-          PPOS(0) = N + 1
-          NELL = NELL - 1
-          NNELL = NNELL - 1
-          ELEMS(IASS) = ELEMS(IASS) - 1
-          LIELL = IW(IELL)
-          NSTKAC(2) = NSTKAC(2) - LIELL
-          J1 = IELL
-          J2 = IELLN - 1
-          IF (IELLN.LT.PTRIRN-IINPUT) THEN
-            IF (IW(IELLN).LT.0) THEN
-              LIELL = LIELL - IW(IELLN)
-              J2 = J2 - IW(IELLN)
-            END IF
-          END IF
-          IF ((IELL-1).EQ.ISTK) THEN
-            ISTK = ISTK + LIELL
-          ELSE
-            IF (IW(IELL-1).LT.0) THEN
-              LIELL = LIELL - IW(IELL-1)
-              J1 = IELL + IW(IELL-1)
-            END IF
-            IW(J1) = -LIELL
-            IW(J2) = -LIELL
-          END IF
-          LAELL = NINT(A(PTRELT))
-          NSTKAC(1) = NSTKAC(1) - LAELL
-          JA1 = PTRELT
-          JA2 = POSELT - 1
-          IF (POSELT.LT.PTRA-AINPUT) THEN
-            IF (NINT(A(POSELT)).LT.0) THEN
-              LAELL = LAELL - NINT(A(POSELT))
-              JA2 = JA2 - NINT(A(POSELT))
-            END IF
-          END IF
-          IF ((PTRELT-1.EQ.ASTK) .AND. (.NOT.NOSURE)) THEN
-            ASTK = ASTK + LAELL
-          ELSE
-            IF (NINT(A(PTRELT-1)).LT.0) THEN
-              LAELL = LAELL - NINT(A(PTRELT-1))
-              JA1 = PTRELT + NINT(A(PTRELT-1))
-            END IF
-            A(JA1) = -LAELL
-            A(JA2) = -LAELL
-          END IF
- 1640     IELL = IELLN
-          PTRELT = POSELT
- 1650   CONTINUE
-        PPOS(0) = N + 1
-        ELEMS(FATHER(IASS)) = ELEMS(FATHER(IASS)) + 1
-        IF (NOSURE) THEN
-          ASTK = APOS4 - 1
-          LAELL = ((NSC1+1)*NSC1)/2 + 2
-        ELSE
-          IF (NSTRUC.EQ.NPIV) THEN
-            LAELL = NUM1* (NUM2+NUM3) + (NUM2* (NUM2+1))/2 + NUM2*NUM3 +
-     +              2
-            JA1 = APOS4 + (NUM1+NUM2)* (NUM2+NUM3) - 1
-          ELSE
-            LAELL = ((NSC1+1)* (NSC1))/2 + 2
-            JA1 = APOS4 + (NSC1)* (NSC1) - 1
-          END IF
-          A(ASTK) = LAELL
-          NSTKAC(1) = NSTKAC(1) + LAELL
-          ASTK = ASTK - 1
-          IF (NSTRUC.EQ.NPIV) THEN
-            DO 1670 I = 1,NUM2
-              DO 1660 JJ = JA1,JA1 - NUM3 - I + 1,-1
-                A(ASTK) = A(JJ)
-                ASTK = ASTK - 1
- 1660         CONTINUE
-              JA1 = JA1 - (NUM2+NUM3)
- 1670       CONTINUE
-            DO 1690 I = 1,NUM1
-              DO 1680 JJ = 1,NUM2 + NUM3
-                A(ASTK) = A(JA1)
-                ASTK = ASTK - 1
-                JA1 = JA1 - 1
- 1680         CONTINUE
- 1690       CONTINUE
-          ELSE
-            DO 1710 I = 1,NSC1
-              DO 1700 JJ = JA1,JA1 - I + 1,-1
-                A(ASTK) = A(JJ)
-                ASTK = ASTK - 1
- 1700         CONTINUE
-              JA1 = JA1 - NSC1
- 1710       CONTINUE
-          END IF
-          A(ASTK) = LAELL
-          ASTK = ASTK - 1
-        END IF
-        LIELL = NCOL - NASS + 4
-        NSTKAC(2) = NSTKAC(2) + LIELL
-        INTSPA = MAX(INTSPA,IWPOS+2*NFRONT+LIELL+NSTKAC(2))
-        IF (IWPOS+2*NFRONT+LIELL.GT.ISTK) THEN
-          CALL MA47PD(IW,ISTK,PTRIRN,IINPUT,NCMPBI)
-          IF (IWPOS+2*NFRONT+LIELL.GT.ISTK) THEN
-            INFO(2) = INTSPA
-            INFO(1) = -3
-            GO TO 2170
-          END IF
-        END IF
-        IW(ISTK) = LIELL
-        ISTK = ISTK - 1
-        NNELL = NNELL + 1
-        DO 1720 I = 1,NCOL - NASS
-          IW(ISTK) = IW(IWPOS+NCOL-I)
-          ISTK = ISTK - 1
- 1720   CONTINUE
-        IF (NSTRUC.EQ.NPIV) THEN
-          IW(ISTK) = NUM2
-          IW(ISTK-1) = NUM1
-        ELSE
-          IW(ISTK) = NCOL - NASS
-          IW(ISTK-1) = 0
-        END IF
-        IW(ISTK-2) = LIELL
-        ISTK = ISTK - 3
- 1730   IF (NPIV+NNULL.LT.NASS) THEN
-          ZCOL = 0
-          APOS1 = APOS + NPIV*NFRONT + NASS - 1
-          DO 1750 J = NASS + 1,NFRONT
-            APOS1 = APOS1 + 1
-            DO 1740 JA1 = 1,NASS - NPIV
-              IF (A(APOS1+ (JA1-1)*NFRONT).NE.ZERO) GO TO 1750
- 1740       CONTINUE
-            IW(IWPOS+J-1) = -IW(IWPOS+J-1)
-            ZCOL = ZCOL + 1
- 1750     CONTINUE
-          ELEMS(FATHER(IASS)) = ELEMS(FATHER(IASS)) + 1
-          LAELL = (NASS-NPIV)* (NFRONT-NPIV-ZCOL) + 2
-          RLSPA = MAX(RLSPA,INFO(2)+APOS+NASS*NFRONT+LAELL+NSTKAC(1))
-          IF (APOS+NASS*NFRONT+LAELL.GT.ASTK) THEN
-            CALL MA47SD(A,ASTK,PTRA,AINPUT,NCMPBR)
-            IF (APOS+NASS*NFRONT+LAELL.GT.ASTK) THEN
-              INFO(2) = INFO(2) + APOS - 1
-              DO 1760 I = 1,NASS*NFRONT
-                A(I) = A(APOS+I-1)
- 1760         CONTINUE
-              APOSBB = 1
-              APOS = 1
-              INFO(1) = -4
-              IF (NASS*NFRONT+LAELL.GT.ASTK) THEN
-                INFO(2) = RLSPA
-                GO TO 2170
-              END IF
-            END IF
-          END IF
-          A(ASTK) = LAELL
-          NSTKAC(1) = NSTKAC(1) + LAELL
-          ASTK = ASTK - LAELL
-          A(ASTK+1) = LAELL
-          JA1 = ASTK + 2
-          JA2 = APOS + NPIV*NFRONT + NPIV
-          IF (ZCOL.EQ.0) THEN
-            DO 1780 I = 1,NASS - NPIV
-              DO 1770 JJ = JA2,JA2 + NFRONT - NPIV - 1
-                A(JA1) = A(JJ)
-                JA1 = JA1 + 1
- 1770         CONTINUE
-              JA2 = JA2 + NFRONT
- 1780       CONTINUE
-          ELSE
-            DO 1800 I = 1,NASS - NPIV
-              DO 1790 JJ = JA2,JA2 + NFRONT - NPIV - 1
-                IF (IW(IWPOS+NPIV+JJ-JA2).GT.0) THEN
-                  A(JA1) = A(JJ)
-                  JA1 = JA1 + 1
-                END IF
- 1790         CONTINUE
-              JA2 = JA2 + NFRONT
- 1800       CONTINUE
-          END IF
-          LIELL = NFRONT - NPIV - ZCOL + 4
-          INTSPA = MAX(INTSPA,IWPOS+2*NFRONT+2+LIELL+NSTKAC(2))
-          IF (IWPOS+2*NFRONT+2+LIELL.GT.ISTK) THEN
-            CALL MA47PD(IW,ISTK,PTRIRN,IINPUT,NCMPBI)
-            IF (IWPOS+2*NFRONT+2+LIELL.GT.ISTK) THEN
-              INFO(2) = INTSPA
-              INFO(1) = -3
-              GO TO 2170
-            END IF
-          END IF
-          NNELL = NNELL + 1
-          IW(ISTK) = LIELL
-          NSTKAC(2) = NSTKAC(2) + LIELL
-          ISTK = ISTK - LIELL
-          IW(ISTK+1) = LIELL
-          IW(ISTK+2) = -1
-          IW(ISTK+3) = NASS - NPIV
-          J1 = ISTK + 4
-          IF (ZCOL.EQ.0) THEN
-            DO 1810 JJ = IWPOS + NPIV,IWPOS + NFRONT - 1
-              IW(J1) = IW(JJ)
-              J1 = J1 + 1
- 1810       CONTINUE
-          ELSE
-            DO 1820 JJ = IWPOS + NPIV,IWPOS + NFRONT - 1
-              IF (IW(JJ).LE.0) THEN
-                IW(JJ) = -IW(JJ)
-              ELSE
-                IW(J1) = IW(JJ)
-                J1 = J1 + 1
-              END IF
- 1820       CONTINUE
-          END IF
-        END IF
- 1830   DO 1840 JJ = IWPOS + NPIV,IWPOS + NFRONT - 1
-          J = ABS(IW(JJ))
-          PPOS(J) = N + 1
- 1840   CONTINUE
-        IF (FATHER(IASS).LE.NODES) THEN
-          ELEMS(FATHER(IASS)) = ELEMS(FATHER(IASS)) + NELL
-        END IF
-C********************************
-C********************************
-        IF (NPIV.EQ.0) GO TO 2160
-        NBLK = NBLK + 1
-        ZCOL = 0
-        APOS1 = APOS + NPIV
-        DO 1880 J = 1,NASS - NPIV
-          DO 1850 JA1 = 1,NPIV
-            IF (A(APOS1+ (JA1-1)*NFRONT).NE.ZERO) GO TO 1870
- 1850     CONTINUE
-          ZCOL = ZCOL + 1
-          APOS2 = APOS + NASS - ZCOL
-          DO 1860 JA1 = 1,NPIV
-            SWOP = A(APOS1+ (JA1-1)*NFRONT)
-            A(APOS1+ (JA1-1)*NFRONT) = A(APOS2+ (JA1-1)*NFRONT)
-            A(APOS2+ (JA1-1)*NFRONT) = SWOP
- 1860     CONTINUE
-          ISWOP = IW(IWPOS+NPIV+J-ZCOL)
-          IW(IWPOS+NPIV+J-ZCOL) = IW(IWPOS+NASS-ZCOL)
-          IW(IWPOS+NASS-ZCOL) = ISWOP
-          GO TO 1880
- 1870     APOS1 = APOS1 + 1
- 1880   CONTINUE
-        IF (ZCOL.GT.0) THEN
-          APOS1 = APOS + NASS - ZCOL
-          APOS2 = APOS + NASS
-          DO 1900 J = 1,NCOL - NASS
-            DO 1890 JA1 = 1,NPIV
-              A(APOS1+ (JA1-1)*NFRONT) = A(APOS2+ (JA1-1)*NFRONT)
- 1890       CONTINUE
-            IW(IWPOS+NASS-ZCOL+J-1) = IW(IWPOS+NASS+J-1)
-            APOS1 = APOS1 + 1
-            APOS2 = APOS2 + 1
- 1900     CONTINUE
-        END IF
-        NCOL = NCOL - ZCOL
-        NASS = NASS - ZCOL
-        IF (NSTRUC.GT.0) THEN
-          IW(IWPOS-4) = -NCOL
-          IW(IWPOS-3) = NSTRUC
-          IF (KIND.EQ.3) IW(IWPOS-3) = -NSTRUC
-          IW(IWPOS-2) = NUM3
-          IF (KIND.EQ.2) THEN
-            DO 1910 I = 1,NCOL
-              IW(IWPOS+I-2) = IW(IWPOS+I-1)
- 1910       CONTINUE
-            IWPOS = IWPOS + NCOL + 3
-            NUM1 = 0
-          ELSE
-            IW(IWPOS-1) = NUM1
-            IWPOS = IWPOS + NCOL + 4
-          END IF
-          IF (NPIV.NE.NSTRUC) THEN
-            NBLK = NBLK + 1
-            J1 = IWPOS - NCOL - 4 + NSTRUC
-            J2 = IWPOS - 2
-            DO 1920 I = NSTRUC + 1,NCOL
-              IW(J2) = IW(J1)
-              J2 = J2 + 1
-              J1 = J1 + 1
- 1920       CONTINUE
-          END IF
-          IF (NSTRUC.LT.NASS) THEN
-            IF (NUM1.NE.0) THEN
-              J1 = IWPOS - 4 - NCOL + NSTRUC
-              J2 = J1
-              DO 1930 I = 1,NASS - NSTRUC
-                PPOS(I) = IW(J2)
-                J2 = J2 + 1
- 1930         CONTINUE
-              J2 = J1 + NASS - NSTRUC
-              DO 1940 I = 1,NUM1
-                IW(J1) = IW(J2)
-                J1 = J1 + 1
-                J2 = J2 + 1
- 1940         CONTINUE
-              DO 1950 I = 1,NASS - NSTRUC
-                IW(J1) = PPOS(I)
-                PPOS(I) = N + 1
-                J1 = J1 + 1
- 1950         CONTINUE
-            END IF
-          END IF
-          IF (NPIV.EQ.NSTRUC) GO TO 1970
-          IWPOS = IWPOS - 2
-        ELSE
-          J1 = IWPOS
-          J2 = IWPOS - 2
-          DO 1960 I = 1,NCOL
-            IW(J2) = IW(J1)
-            J2 = J2 + 1
-            J1 = J1 + 1
- 1960     CONTINUE
-          IWPOS = IWPOS - 2
-        END IF
-        IW(IWPOS-2) = NCOL - NSTRUC
-        IW(IWPOS-1) = NPIV - NSTRUC
-        IWPOS = IWPOS + NCOL - NSTRUC + 4
- 1970   IF (INFO(1).EQ.-4) THEN
-          INFO(2) = INFO(2) + ((NPIV-NSTRUC)* (2*NCOL-NPIV+NSTRUC+1))/2
-          GO TO 2160
-        END IF
-        APOS2 = APOSBB
-        DO 1990 I = 1,NSTRUC/2
-          JA1 = APOS + (I-1)*NFRONT + NSTRUC/2
-          DO 1980 J = 1,NSTRUC/2
-            A(APOS2) = A(JA1)
-            APOS2 = APOS2 + 1
-            JA1 = JA1 + 1
- 1980     CONTINUE
- 1990   CONTINUE
-        IF (KIND.EQ.2) THEN
-          DO 2010 I = 1,NSTRUC/2
-            JA1 = APOS + (NSTRUC/2+I-1)* (NFRONT+1) + 1
-            DO 2000 J = I + 1,NSTRUC/2
-              A(APOS2) = A(JA1)
-              APOS2 = APOS2 + 1
-              JA1 = JA1 + 1
- 2000       CONTINUE
- 2010     CONTINUE
-          JA1 = APOS
-          DO 2020 I = 1,NSTRUC/2
-            A(APOS2) = A(JA1)
-            JA1 = JA1 + NFRONT + 1
-            APOS2 = APOS2 + 1
- 2020     CONTINUE
-          DO 2030 I = 1,NSTRUC/2
-            A(APOS2) = ZERO
-            APOS2 = APOS2 + 1
- 2030     CONTINUE
-        ELSE
-          DO 2040 I = 1,NSTRUC
-            A(APOS2) = ZERO
-            APOS2 = APOS2 + 1
- 2040     CONTINUE
-        END IF
-        DO 2070 I = 1,NSTRUC/2
-          JA1 = APOS + (I-1)*NFRONT + NSTRUC
-          DO 2050 J = NSTRUC + 1,NASS
-            A(APOS2) = A(JA1)
-            APOS2 = APOS2 + 1
-            JA1 = JA1 + 1
- 2050     CONTINUE
-          JA1 = JA1 + NUM1
-          DO 2060 J = 1,NCOL - NASS - NUM1
-            A(APOS2) = A(JA1)
-            APOS2 = APOS2 + 1
-            JA1 = JA1 + 1
- 2060     CONTINUE
- 2070   CONTINUE
-        DO 2110 I = NSTRUC/2 + 1,NSTRUC
-          JA1 = APOS + (I-1)*NFRONT + NASS
-          DO 2080 J = 1,NUM1
-            A(APOS2) = A(JA1)
-            APOS2 = APOS2 + 1
-            JA1 = JA1 + 1
- 2080     CONTINUE
-          JA1 = APOS + (I-1)*NFRONT + NSTRUC
-          DO 2090 J = 1,NASS - NSTRUC
-            A(APOS2) = A(JA1)
-            APOS2 = APOS2 + 1
-            JA1 = JA1 + 1
- 2090     CONTINUE
-          JA1 = APOS + (I-1)*NFRONT + NASS + NUM1
-          DO 2100 J = 1,NCOL - NASS - NUM1 - NUM3
-            A(APOS2) = A(JA1)
-            APOS2 = APOS2 + 1
-            JA1 = JA1 + 1
- 2100     CONTINUE
- 2110   CONTINUE
-        DO 2130 I = 1,NPIV - NSTRUC
-          JA1 = APOS + (NSTRUC+I-1)* (NFRONT+1)
-          DO 2120 J = I,NPIV - NSTRUC
-            A(APOS2) = A(JA1)
-            APOS2 = APOS2 + 1
-            JA1 = JA1 + 1
- 2120     CONTINUE
- 2130   CONTINUE
-        DO 2150 I = 1,NPIV - NSTRUC
-          JA1 = APOS + (NSTRUC+I-1)*NFRONT + NPIV
-          DO 2140 J = 1,NCOL - NPIV
-            A(APOS2) = A(JA1)
-            APOS2 = APOS2 + 1
-            JA1 = JA1 + 1
- 2140     CONTINUE
- 2150   CONTINUE
-        APOSBB = APOS2
- 2160 CONTINUE
-      IF (INFO(1).EQ.-4) THEN
-        INFO(2) = RLSPA
-        GO TO 2170
-      END IF
-      NRLBDU = APOSBB - 1
-      NIRBDU = IWPOS - 5
-      IW(1) = NRLBDU + 1
-      IW(2) = NRLBDU + NFULLB
-      IW(3) = NBLK
-      CALL MA47WD(A,LA,IW,LIW,NRLBDU)
-      INFO(6) = MAX(2*NE,RLSPA)
-      INFO(7) = MAX(2*NE,INTSPA)
-      INFO(15) = MAXFRT
-      INFO(16) = NRLBDU
-      INFO(17) = NIRBDU
-      INFO(18) = NCMPBR
-      INFO(19) = NCMPBI
-      INFO(20) = NTILEB
-      INFO(21) = NOXOB
-      INFO(22) = NFULLB
-      INFO(23) = NEIG
-      INFO(24) = N - NTOTPV
-      RINFO(3) = FLOPSB
-      RINFO(4) = FLOPSX
- 2170 RETURN
-      END
-      SUBROUTINE MA47PD(IW,BOTTOM,TOP,MOVE,NCMP)
-      INTEGER IW(*)
-      INTEGER BOTTOM,TOP,MOVE,NCMP
-      INTEGER IDUMMY,JJ,K,SIZE
-      NCMP = NCMP + 1
-      K = TOP - MOVE - 1
-      DO 20 IDUMMY = 1,TOP
-        IF (K.LE.BOTTOM) GO TO 30
-        SIZE = IW(K)
-        IF (SIZE.LT.0) THEN
-          MOVE = MOVE - SIZE
-          K = K + SIZE
-        ELSE
-          IF (MOVE.GT.0) THEN
-            DO 10 JJ = K,K - SIZE + 1,-1
-              IW(JJ+MOVE) = IW(JJ)
-   10       CONTINUE
-          END IF
-          K = K - SIZE
-        END IF
-   20 CONTINUE
-   30 BOTTOM = BOTTOM + MOVE
-      MOVE = 0
-      RETURN
-      END
-      SUBROUTINE MA47QD(N,A,LA,IW,LIW,W,RHS,IW1,ICNTL)
-      INTEGER N,LA
-      DOUBLE PRECISION A(LA)
-      INTEGER LIW,IW(LIW)
-      DOUBLE PRECISION W(N),RHS(N)
-      INTEGER IW1(N),ICNTL(7)
-      INTRINSIC ABS
-      EXTERNAL DGEMV,DTPMV,DTPSV,DTRSV
-      DOUBLE PRECISION ONE
-      PARAMETER (ONE=1.0D0)
-      INTEGER APOS,APOSM,APOSO,I,IBLK,IPIV,IRHS,IWPOS,J,J1,J2,K,KIND,
-     +        NCOLS,NROWS,NUM1,NUM3,N2
-      DOUBLE PRECISION W1
-      APOS = 1
-      IWPOS = 4
-      DO 270 IBLK = 1,IW(3)
-        IW1(IBLK) = IWPOS
-        NCOLS = IW(IWPOS)
-        NROWS = IW(IWPOS+1)
-        IWPOS = IWPOS + 2
-        NUM1 = 0
-        NUM3 = 0
-        IF (NCOLS.GT.0) THEN
-          KIND = 1
-          N2 = NROWS
-        ELSE
-          NCOLS = -NCOLS
-          NUM3 = IW(IWPOS)
-          IWPOS = IWPOS + 1
-          IF (NROWS.GT.0) THEN
-            KIND = 2
-          ELSE
-            NROWS = -NROWS
-            NUM1 = IW(IWPOS)
-            IWPOS = IWPOS + 1
-            KIND = 3
-          END IF
-          N2 = NROWS/2
-        END IF
-        IF (N2.GT.ICNTL(7)) THEN
-          DO 10 I = 1,NCOLS
-            W(I) = RHS(ABS(IW(IWPOS+I-1)))
-   10     CONTINUE
-          IF (KIND.EQ.1) THEN
-            CALL DTPSV('L','N','U',NROWS,A(APOS),W,1)
-            APOS = APOS + (NROWS* (NROWS+1))/2
-            IF (NCOLS.GT.NROWS) CALL DGEMV('N',NCOLS-NROWS,NROWS,ONE,
-     +                               A(APOS),NCOLS-NROWS,W,1,ONE,
-     +                               W(NROWS+1),1)
-            APOS = APOS + NROWS* (NCOLS-NROWS)
-            DO 35 I = 1,NCOLS
-              RHS(ABS(IW(IWPOS+I-1))) = W(I)
-   35       CONTINUE
-          ELSE IF (KIND.EQ.2) THEN
-            CALL DTRSV('U','T','U',N2,A(APOS),N2,W,1)
-            APOSM = APOS + N2*N2
-            APOSO = APOSM + (N2* (N2+1))/2 + N2
-            K = NCOLS - NROWS
-            IF (K.GT.NUM1) CALL DGEMV('N',K-NUM1,N2,ONE,A(APOSO),K-NUM1,
-     +                                W,1,ONE,W(NROWS+1+NUM1),1)
-            DO 40 I = 1,N2
-              RHS(ABS(IW(IWPOS+I-1))) = W(I)
-   40       CONTINUE
-            CALL DTPMV('L','N','N',N2-1,A(APOSM),W,1)
-            DO 50 I = N2 + 2,NROWS
-              W(I) = W(I) + W(I-N2-1)
-   50       CONTINUE
-            CALL DTRSV('L','N','U',N2,A(APOS),N2,W(N2+1),1)
-            APOS = APOSO + N2* (K-NUM1)
-            IF (K.GT.NUM3) CALL DGEMV('N',K-NUM3,N2,ONE,A(APOS),K-NUM3,
-     +                                W(N2+1),1,ONE,W(NROWS+1),1)
-            APOS = APOS + N2* (K-NUM3)
-            DO 60 I = N2 + 1,NCOLS
-              RHS(ABS(IW(IWPOS+I-1))) = W(I)
-   60       CONTINUE
-          ELSE
-            CALL DTRSV('U','T','U',N2,A(APOS),N2,W,1)
-            CALL DTRSV('L','N','U',N2,A(APOS),N2,W(N2+1),1)
-            APOS = APOS + N2*N2 + 2*N2
-            K = NCOLS - NROWS
-            IF (K.GT.NUM1) CALL DGEMV('N',K-NUM1,N2,ONE,A(APOS),K-NUM1,
-     +                                W,1,ONE,W(NROWS+1+NUM1),1)
-            APOS = APOS + N2* (K-NUM1)
-            IF (K.GT.NUM3) CALL DGEMV('N',K-NUM3,N2,ONE,A(APOS),K-NUM3,
-     +                                W(N2+1),1,ONE,W(NROWS+1),1)
-            APOS = APOS + N2* (K-NUM3)
-            DO 90 I = 1,NCOLS
-              RHS(ABS(IW(IWPOS+I-1))) = W(I)
-   90       CONTINUE
-          END IF
-        ELSE
-          J1 = IWPOS
-          J2 = IWPOS + NROWS - 1
-          IF (KIND.EQ.1) THEN
-            DO 130 IPIV = 1,NROWS
-              APOS = APOS + 1
-              W1 = RHS(ABS(IW(J1)))
-              J1 = J1 + 1
-              DO 100 J = J1,J2
-                IRHS = ABS(IW(J))
-                RHS(IRHS) = RHS(IRHS) - A(APOS)*W1
-                APOS = APOS + 1
-  100         CONTINUE
-  130       CONTINUE
-            J2 = IWPOS + NCOLS - 1
-            DO 136 IPIV = 1,NROWS
-              W1 = RHS(ABS(IW(IWPOS+IPIV-1)))
-              DO 133 J = J1,J2
-                IRHS = ABS(IW(J))
-                RHS(IRHS) = RHS(IRHS) + W1*A(APOS)
-                APOS = APOS + 1
-  133         CONTINUE
-  136       CONTINUE
-          ELSE
-            J2 = IWPOS + N2 - 1
-            APOSO = APOS + N2*N2
-            DO 145 IPIV = 1,N2 - 1
-              K = APOS + (IPIV-1)* (N2+1)
-              W1 = RHS(-IW(J1))
-              J1 = J1 + 1
-              DO 140 J = J1,J2
-                IRHS = ABS(IW(J))
-                K = K + N2
-                RHS(IRHS) = RHS(IRHS) - W1*A(K)
-  140         CONTINUE
-  145       CONTINUE
-            IF (KIND.EQ.2) THEN
-              K = APOSO
-              APOSO = APOSO + (N2* (N2+1))/2 + N2
-              J1 = IWPOS
-              DO 155 IPIV = 1,N2 - 1
-                W1 = RHS(-IW(J1))
-                J1 = J1 + 1
-                DO 150 J = J1,J2
-                  IRHS = ABS(IW(J+N2))
-                  RHS(IRHS) = RHS(IRHS) + W1*A(K)
-                  K = K + 1
-  150           CONTINUE
-  155         CONTINUE
-            ELSE
-              APOSO = APOSO + 2*N2
-            END IF
-            J1 = IWPOS + N2
-            J2 = J2 + N2
-            DO 165 IPIV = 1,N2 - 1
-              K = APOS + (IPIV-1)* (N2+1)
-              W1 = RHS(-IW(J1))
-              J1 = J1 + 1
-              DO 160 J = J1,J2
-                IRHS = ABS(IW(J))
-                K = K + 1
-                RHS(IRHS) = RHS(IRHS) - W1*A(K)
-  160         CONTINUE
-  165       CONTINUE
-            APOS = APOSO
-            J1 = IWPOS + NROWS
-            J2 = IWPOS + NCOLS - 1
-            DO 195 IPIV = 1,N2
-              W1 = RHS(ABS(IW(IWPOS+IPIV-1)))
-              DO 190 J = J1 + NUM1,J2
-                IRHS = ABS(IW(J))
-                RHS(IRHS) = RHS(IRHS) + W1*A(APOS)
-                APOS = APOS + 1
-  190         CONTINUE
-  195       CONTINUE
-            DO 210 IPIV = 1,N2
-              W1 = RHS(ABS(IW(IWPOS+IPIV-1+N2)))
-              DO 200 J = J1,J2 - NUM3
-                IRHS = ABS(IW(J))
-                RHS(IRHS) = RHS(IRHS) + W1*A(APOS)
-                APOS = APOS + 1
-  200         CONTINUE
-  210       CONTINUE
-          END IF
-        END IF
-        IWPOS = IWPOS + NCOLS
-  270 CONTINUE
-      END
-      SUBROUTINE MA47RD(N,A,LA,IW,LIW,W,RHS,IW1,ICNTL)
-      INTEGER N,LA
-      DOUBLE PRECISION A(LA)
-      INTEGER LIW,IW(LIW)
-      DOUBLE PRECISION W(N),RHS(N)
-      INTEGER IW1(N),ICNTL(7)
-      INTRINSIC ABS
-      EXTERNAL DGEMV,DTPMV,DTPSV,DTRSV
-      DOUBLE PRECISION ONE
-      PARAMETER (ONE=1.0D0)
-      INTEGER APOS,APOSD,APOSE,APOSF,APOSM,APOS2,I,IBLK,IPIV,IRHS,IRHS1,
-     +        IRHS2,IWPOS,J,JPIV,J1,J2,K,KIND,LROW,NCOLS,NROWS,NUM1,
-     +        NUM3,N2
-      DOUBLE PRECISION W1
-      APOS = IW(1)
-      APOS2 = IW(2)
-      DO 380 IBLK = IW(3),1,-1
-        IWPOS = IW1(IBLK)
-        NCOLS = ABS(IW(IWPOS))
-        NROWS = ABS(IW(IWPOS+1))
-        NUM1 = 0
-        NUM3 = 0
-        IF (IW(IWPOS).GT.0) THEN
-          KIND = 1
-          APOS = APOS - NROWS* (NCOLS-NROWS)
-          N2 = NROWS
-        ELSE
-          N2 = NROWS/2
-          APOS = APOS - (NROWS* (NCOLS+NCOLS-NROWS+1))/2
-          NUM3 = IW(IWPOS+2)
-          APOS = APOS + NUM3*N2 + (N2* (N2+1))/2
-          IWPOS = IWPOS + 1
-          IF (IW(IWPOS).GT.0) THEN
-            APOS = APOS - N2
-            KIND = 2
-          ELSE
-            NUM1 = IW(IWPOS+2)
-            APOS = APOS + NUM1*N2 + (N2* (N2+1))/2
-            APOS = APOS - 2*N2
-            IWPOS = IWPOS + 1
-            KIND = 3
-          END IF
-        END IF
-        IWPOS = IWPOS + 2
-        IF (N2.GT.ICNTL(7)) THEN
-          DO 5 I = NROWS + 1,NCOLS
-            W(I) = RHS(ABS(IW(IWPOS+I-1)))
-    5     CONTINUE
-          IF (KIND.EQ.1) THEN
-            DO 10 IPIV = NROWS,1,-1
-              IRHS = ABS(IW(IWPOS+IPIV-1))
-              APOS = APOS - (NROWS+1-IPIV)
-              W(IPIV) = RHS(IRHS)*A(APOS)
-   10       CONTINUE
-            JPIV = -1
-            DO 20 IPIV = NROWS,1,-1
-              IRHS = IW(IWPOS+IPIV-1)
-              IF (IRHS.LT.0) THEN
-                IRHS1 = -IW(IWPOS+IPIV-1+JPIV)
-                W(IPIV) = RHS(IRHS1)*A(APOS2) + W(IPIV)
-                IF (JPIV.EQ.1) APOS2 = APOS2 - 1
-                JPIV = -JPIV
-              END IF
-   20       CONTINUE
-            K = NCOLS - NROWS
-            IF (K.GT.0) CALL DGEMV('T',K,NROWS,ONE,
-     +                             A(APOS+ (NROWS* (NROWS+1))/2),K,
-     +                             W(NROWS+1),1,ONE,W,1)
-            CALL DTPSV('L','T','U',NROWS,A(APOS),W,1)
-            DO 60 I = 1,NROWS
-              RHS(ABS(IW(IWPOS+I-1))) = W(I)
-   60       CONTINUE
-          ELSE
-            APOSD = APOS
-            APOSM = APOS + N2*N2
-            APOSE = APOSM + (N2* (N2-1))/2
-            IF (KIND.EQ.3) APOSE = APOSM
-            APOSF = APOSE + N2
-            DO 70 IPIV = 1,N2
-              IRHS1 = -IW(IWPOS+IPIV-1)
-              IRHS2 = -IW(IWPOS+IPIV-1+N2)
-              W(IPIV) = RHS(IRHS1)*A(APOSE) + RHS(IRHS2)*A(APOSD)
-              W(IPIV+N2) = RHS(IRHS1)*A(APOSD) + RHS(IRHS2)*A(APOSF)
-              APOSD = APOSD + N2 + 1
-              APOSE = APOSE + 1
-              APOSF = APOSF + 1
-   70       CONTINUE
-            APOSD = APOS
-            APOS = APOSF
-            K = NCOLS - NROWS
-            IF (K.GT.NUM1) CALL DGEMV('T',K-NUM1,N2,ONE,A(APOS),K-NUM1,
-     +                                W(NROWS+NUM1+1),1,ONE,W,1)
-            IF (K.GT.NUM3) CALL DGEMV('T',K-NUM3,N2,ONE,
-     +                                A(APOS+N2* (K-NUM1)),K-NUM3,
-     +                                W(NROWS+1),1,ONE,W(N2+1),1)
-            IF (KIND.EQ.2) THEN
-              APOS = APOSD
-              CALL DTRSV('L','T','U',N2,A(APOSD),N2,W(N2+1),1)
-              DO 90 I = N2 + 1,NROWS
-                RHS(ABS(IW(IWPOS+I-1))) = W(I)
-   90         CONTINUE
-              CALL DTPMV('L','T','N',N2-1,A(APOSM),W(N2+2),1)
-              DO 100 I = 1,N2 - 1
-                W(I) = W(I) + W(I+N2+1)
-  100         CONTINUE
-              CALL DTRSV('U','N','U',N2,A(APOSD),N2,W,1)
-              DO 110 I = 1,N2
-                RHS(ABS(IW(IWPOS+I-1))) = W(I)
-  110         CONTINUE
-            ELSE
-              APOS = APOSD
-              CALL DTRSV('L','T','U',N2,A(APOS),N2,W(N2+1),1)
-              CALL DTRSV('U','N','U',N2,A(APOS),N2,W,1)
-              DO 180 I = 1,NROWS
-                RHS(ABS(IW(IWPOS+I-1))) = W(I)
-  180         CONTINUE
-            END IF
-          END IF
-        ELSE
-          J1 = IWPOS
-          J2 = IWPOS + NCOLS - 1
-          K = APOS
-          IF (KIND.EQ.1) THEN
-            JPIV = -1
-            DO 210 IPIV = NROWS,1,-1
-              IRHS = IW(IWPOS+IPIV-1)
-              LROW = NROWS + 1 - IPIV
-              IF (IRHS.GT.0) THEN
-                APOS = APOS - LROW
-                RHS(IRHS) = RHS(IRHS)*A(APOS)
-              ELSE
-                IF (JPIV.EQ.-1) THEN
-                  IRHS1 = -IW(IWPOS+IPIV-2)
-                  IRHS2 = -IRHS
-                  APOS = APOS - LROW - LROW - 1
-                  W1 = RHS(IRHS1)*A(APOS) + RHS(IRHS2)*A(APOS2)
-                  RHS(IRHS2) = RHS(IRHS1)*A(APOS2) +
-     +                         RHS(IRHS2)*A(APOS+LROW+1)
-                  RHS(IRHS1) = W1
-                  APOS2 = APOS2 - 1
-                END IF
-                JPIV = -JPIV
-              END IF
-  210       CONTINUE
-            APOS = APOS + (NROWS* (NROWS+1))/2
-            K = APOS
-            J1 = IWPOS + NROWS
-            DO 220 IPIV = 1,NROWS
-              IRHS = ABS(IW(IWPOS+IPIV-1))
-              W1 = RHS(IRHS)
-              DO 215 J = J1,J2
-                W1 = W1 + A(K)*RHS(ABS(IW(J)))
-                K = K + 1
-  215         CONTINUE
-              RHS(IRHS) = W1
-  220       CONTINUE
-            J2 = IWPOS + NROWS - 1
-            DO 260 IPIV = 1,NROWS
-              IRHS = ABS(IW(J1-1))
-              APOS = APOS - IPIV
-              W1 = RHS(IRHS)
-              K = APOS + 1
-              DO 230 J = J1,J2
-                W1 = W1 - A(K)*RHS(ABS(IW(J)))
-                K = K + 1
-  230         CONTINUE
-              RHS(IRHS) = W1
-              J1 = J1 - 1
-  260       CONTINUE
-          ELSE
-            APOSD = APOS
-            APOSM = APOS + N2*N2
-            APOSE = APOSM + (N2* (N2-1))/2
-            IF (KIND.EQ.3) APOSE = APOSM
-            APOSF = APOSE + N2
-            DO 270 IPIV = N2,1,-1
-              IRHS1 = -IW(J1)
-              IRHS2 = -IW(J1+N2)
-              W1 = RHS(IRHS1)*A(APOSE) + RHS(IRHS2)*A(APOSD)
-              RHS(IRHS2) = RHS(IRHS1)*A(APOSD) + RHS(IRHS2)*A(APOSF)
-              RHS(IRHS1) = W1
-              APOSD = APOSD + N2 + 1
-              APOSE = APOSE + 1
-              APOSF = APOSF + 1
-              J1 = J1 + 1
-  270       CONTINUE
-            K = APOSF
-            J1 = IWPOS + NROWS
-            DO 295 IPIV = 1,N2
-              IRHS1 = ABS(IW(IWPOS+IPIV-1))
-              W1 = RHS(IRHS1)
-              DO 290 J = J1 + NUM1,J2
-                IRHS = ABS(IW(J))
-                W1 = W1 + RHS(IRHS)*A(K)
-                K = K + 1
-  290         CONTINUE
-              RHS(IRHS1) = W1
-  295       CONTINUE
-            DO 310 IPIV = 1,N2
-              IRHS2 = ABS(IW(IWPOS+IPIV-1+N2))
-              W1 = RHS(IRHS2)
-              DO 300 J = J1,J2 - NUM3
-                IRHS = ABS(IW(J))
-                W1 = W1 + RHS(IRHS)*A(K)
-                K = K + 1
-  300         CONTINUE
-              RHS(IRHS2) = W1
-  310       CONTINUE
-            J1 = IWPOS + NROWS - 1
-            J2 = J1
-            DO 330 IPIV = N2 - 1,1,-1
-              IRHS1 = -IW(J1-1)
-              K = APOS + (IPIV-1)* (N2+1)
-              DO 320 J = J1,J2
-                K = K + 1
-                RHS(IRHS1) = RHS(IRHS1) - RHS(ABS(IW(J)))*A(K)
-  320         CONTINUE
-              J1 = J1 - 1
-  330       CONTINUE
-            IF (KIND.EQ.2) THEN
-              K = APOSM
-              DO 350 IPIV = 1,N2 - 1
-                J1 = J1 + 1
-                IRHS2 = -IW(J1-1-N2)
-                DO 340 J = J1,J2
-                  RHS(IRHS2) = RHS(IRHS2) + RHS(ABS(IW(J)))*A(K)
-                  K = K + 1
-  340           CONTINUE
-  350         CONTINUE
-            END IF
-            J1 = J2 - N2
-            J2 = J1
-            DO 370 IPIV = N2 - 1,1,-1
-              IRHS2 = -IW(J1-1)
-              K = APOS + (IPIV-1)* (N2+1)
-              DO 360 J = J1,J2
-                K = K + N2
-                RHS(IRHS2) = RHS(IRHS2) - RHS(ABS(IW(J)))*A(K)
-  360         CONTINUE
-              J1 = J1 - 1
-  370       CONTINUE
-          END IF
-        END IF
-  380 CONTINUE
-      END
-      SUBROUTINE MA47SD(A,BOTTOM,TOP,MOVE,NCMP)
-      DOUBLE PRECISION A(*)
-      INTEGER BOTTOM,TOP,NCMP
-      INTEGER IDUMMY,JJ,K,MOVE,SIZE
-      NCMP = NCMP + 1
-      K = TOP - MOVE - 1
-      DO 20 IDUMMY = 1,TOP
-        IF (K.LE.BOTTOM) GO TO 30
-        SIZE = A(K)
-        IF (SIZE.LT.0) THEN
-          MOVE = MOVE - SIZE
-          K = K + SIZE
-        ELSE
-          IF (MOVE.GT.0) THEN
-            DO 10 JJ = K,K - SIZE + 1,-1
-              A(JJ+MOVE) = A(JJ)
-   10       CONTINUE
-          END IF
-          K = K - SIZE
-        END IF
-   20 CONTINUE
-   30 BOTTOM = BOTTOM + MOVE
-      MOVE = 0
-      RETURN
-      END
-      SUBROUTINE MA47TD(N,IPE,IW,LW,NV,NEXT,LAST,LEAF,FLAG,VAR,SVAR)
-      INTEGER N,IPE(N),LW,IW(LW),NV(N),NEXT(N),LAST(N),LEAF(N),FLAG(N),
-     +        VAR(N),SVAR(N)
-      INTRINSIC SIGN
-      INTEGER FREE,I,IS,J,JS,K,KK,LS,NS
-      DO 10 I = 1,N
-        SVAR(I) = 1
-        LAST(I) = I - 1
-        NEXT(I) = I + 1
-        FLAG(I) = 0
-        VAR(I) = I + 1
-   10 CONTINUE
-      LAST(1) = N
-      NEXT(N) = 1
-      FREE = 2
-      DO 30 J = 1,N
-        KK = IPE(J)
-        DO 20 K = KK + 1,KK + IW(KK)
-          I = IW(K)
-          IS = SVAR(I)
-          IF (FLAG(IS).NE.J) THEN
-            FLAG(IS) = J
-            IF (NEXT(I).EQ.I) THEN
-            ELSE
-              JS = FREE
-              FREE = VAR(JS)
-              VAR(IS) = I
-              SVAR(I) = JS
-              NS = NEXT(I)
-              LS = LAST(I)
-              NEXT(LS) = NS
-              LAST(NS) = LS
-              NEXT(I) = I
-              LAST(I) = I
-            END IF
-          ELSE
-            IF (NEXT(I).EQ.I) THEN
-              NS = VAR(IS)
-              VAR(IS) = FREE
-              FREE = IS
-            ELSE
-              NS = NEXT(I)
-              LS = LAST(I)
-              NEXT(LS) = NS
-              LAST(NS) = LS
-              NS = VAR(IS)
-            END IF
-            LS = LAST(NS)
-            NEXT(LS) = I
-            NEXT(I) = NS
-            LAST(NS) = I
-            LAST(I) = LS
-            SVAR(I) = SVAR(NS)
-          END IF
-   20   CONTINUE
-   30 CONTINUE
-      DO 60 IS = 1,N
-        LEAF(IS) = IS
-        IF (LAST(IS).EQ.IS) GO TO 60
-        IF (LAST(IS).LT.0) GO TO 60
-        LS = LAST(IS)
-        LEAF(IS) = LS
-        DO 40 K = 1,N
-          I = LS
-          IF (I.EQ.IS) GO TO 50
-          IPE(I) = 0
-          LS = LAST(I)
-          NEXT(I) = -LS
-          LAST(I) = -LS
-          NV(I) = 0
-   40   CONTINUE
-   50   NV(IS) = SIGN(K,NV(IS))
-   60 CONTINUE
-      END
-      SUBROUTINE MA47UD(A,LA,IW,LIW,ICNTL)
-      INTEGER LA
-      DOUBLE PRECISION A(LA)
-      INTEGER LIW,IW(LIW),ICNTL(7)
-      INTRINSIC ABS,INT,MIN,SIGN
-      CHARACTER*72 LINE
-      INTEGER APOS,APOSM,APOS2,IBLK,ILINE,IROW,IWPOS,J,JPIV,J1,J2,K,
-     +        KIND,LDIAG,LEN,MP,NBLK,NCOLS,NROWS,NUM1,NUM3,N2
-      CHARACTER*1 NZ,SGN,PM(-2:2)
-      DOUBLE PRECISION AK
-      DATA PM/'*','-','.','+','.'/
-      SGN(K) = PM(SIGN(1,K))
-      NZ(AK) = PM(INT(SIGN(2D0,-ABS(AK))))
-      MP = ICNTL(2)
-      LDIAG = ICNTL(3)
-      APOS2 = IW(1)
-      NBLK = IW(3)
-      IF (LDIAG.LE.2) NBLK = 0
-      IF (LDIAG.EQ.3) NBLK = MIN(1,NBLK)
-      LEN = 12
-      IF (LDIAG.EQ.5) LEN = 1
-      IF (LEN.EQ.12) THEN
-        IF (NBLK.EQ.IW(3)) THEN
-          WRITE (MP,'(A)')
-     +      ' For each block, the following information is provided:'
-        ELSE
-          WRITE (MP,'(A,A)') ' For the first block only,',
-     +      ' the following information is provided:'
-        END IF
-      END IF
-      IF (LEN.EQ.12) WRITE (MP,'(A)')
-     +    '   1. Block number, number of rows, number of columns',
-     +    '   2. Whether the block is full, tile, or oxo',
-     +    '   3. List of indices for the pivot, each negated if part of'
-     +    ,'      a 2x2 pivot',
-     +    '   4. The factorized block pivot (see below)',
-     +    '   5. List of indices for the non-pivot columns',
-     +    '   6. The non-pivot part, with structural zeros printed as',
-     +    '      0000000000',' A factorized full pivot has the form',
-     +    '               T','        L  D  L ',
-     +    '                          T',
-     +    ' and is printed as D and L  packed together.'
-      IF (LEN.EQ.12) WRITE (MP,'(A)')
-     +    ' A factorized tile or oxo pivot has the form',
-     +    '                              T',
-     +    '       ( L     ) ( F   D ) ( L   M )',
-     +    '       (  T  T ) (       ) (       )',
-     +    '       ( M  U  ) ( D   E ) (     U )',
-     +    ' where L is unit lower triangular; D, E, and F are diagonal;'
-     +    ,
-     +   ' M is zero for an oxo pivot and is upper triangular with zero'
-     +    ,' diagonal for a tile pivot; and U is upper triangular with',
-     +    ' unit diagonal. It is printed as',
-     +    '    a. L,D,U  packed together,',
-     +    '    b. M (tile case only) in packed form,','    c. F and E.'
-      IWPOS = 4
-      APOS = 1
-      DO 300 IBLK = 1,NBLK
-        NCOLS = IW(IWPOS)
-        NROWS = IW(IWPOS+1)
-        IWPOS = IWPOS + 2
-        IF (NCOLS.GT.0) THEN
-          KIND = 1
-        ELSE
-          NCOLS = -NCOLS
-          NUM3 = IW(IWPOS)
-          IWPOS = IWPOS + 1
-          IF (NROWS.GT.0) THEN
-            KIND = 2
-          ELSE
-            NROWS = -NROWS
-            NUM1 = IW(IWPOS)
-            IWPOS = IWPOS + 1
-            KIND = 3
-          END IF
-        END IF
-        WRITE (MP,'(4(A,I6))') ' Block',IBLK,' with',NROWS,' rows and',
-     +    NCOLS,' columns'
-        IF (KIND.EQ.1) WRITE (MP,'(A)') ' Full pivot'
-        IF (KIND.EQ.2) WRITE (MP,'(A)') ' Tile pivot'
-        IF (KIND.EQ.3) WRITE (MP,'(A)') ' Oxo pivot'
-        IF (LEN.EQ.12) WRITE (MP,'(6I12)') (IW(K),K=IWPOS,IWPOS+NROWS-1)
-        IF (LEN.EQ.1) WRITE (MP,'(72A1)') (SGN(IW(K)),K=IWPOS,
-     +      IWPOS+NROWS-1)
-        IF (KIND.EQ.1) THEN
-          JPIV = 0
-          DO 30 IROW = 1,NROWS
-            IF (JPIV.EQ.1) THEN
-              JPIV = 0
-            ELSE
-              IF (IW(IWPOS+IROW-1).LT.0) JPIV = 1
-            END IF
-            ILINE = 1
-            DO 10 J = 1,IROW - 1
-              WRITE (LINE(ILINE:ILINE+LEN-1),'(A)') ' '
-              ILINE = ILINE + LEN
-              IF (ILINE.GT.72) THEN
-                WRITE (MP,'(A)') LINE
-                ILINE = 1
-              END IF
-   10       CONTINUE
-            DO 20 J = IROW,NROWS
-              IF (LEN.EQ.12) WRITE (LINE(ILINE:ILINE+11),
-     +            '(1P,D12.4)') A(APOS)
-              IF (LEN.EQ.1) WRITE (LINE(ILINE:ILINE),'(A)') NZ(A(APOS))
-              APOS = APOS + 1
-              IF (J.EQ.IROW+1) THEN
-                IF (JPIV.EQ.1) THEN
-                  IF (LEN.EQ.12) WRITE (LINE(ILINE:ILINE+11),
-     +                '(1P,D12.4)') A(APOS2)
-                  IF (LEN.EQ.1) WRITE (LINE(ILINE:ILINE),
-     +                '(A)') NZ(A(APOS2))
-                  APOS2 = APOS2 + 1
-                END IF
-              END IF
-              ILINE = ILINE + LEN
-              IF (ILINE.GT.72) THEN
-                WRITE (MP,'(A)') LINE
-                ILINE = 1
-              END IF
-   20       CONTINUE
-            IF (ILINE.GT.1) THEN
-              LINE(ILINE:) = ' '
-              WRITE (MP,'(A)') LINE
-            END IF
-   30     CONTINUE
-        ELSE
-          N2 = NROWS/2
-          DO 50 IROW = 1,N2
-            ILINE = 1
-            DO 40 J = 1,N2
-              IF (LEN.EQ.12) WRITE (LINE(ILINE:ILINE+11),
-     +            '(1P,D12.4)') A(APOS)
-              IF (LEN.EQ.1) WRITE (LINE(ILINE:ILINE),'(A)') NZ(A(APOS))
-              APOS = APOS + 1
-              ILINE = ILINE + LEN
-              IF (ILINE.GT.72) THEN
-                WRITE (MP,'(A)') LINE
-                ILINE = 1
-              END IF
-   40       CONTINUE
-            IF (ILINE.GT.1) THEN
-              LINE(ILINE:) = ' '
-              WRITE (MP,'(A)') LINE
-            END IF
-   50     CONTINUE
-          IF (KIND.EQ.2) THEN
-            DO 80 IROW = 2,N2
-              ILINE = 1
-              APOSM = APOS + IROW - 2
-              DO 60 J = 1,IROW - 1
-                IF (LEN.EQ.12) WRITE (LINE(ILINE:ILINE+11),
-     +              '(1P,D12.4)') A(APOSM)
-                IF (LEN.EQ.1) WRITE (LINE(ILINE:ILINE),
-     +              '(A)') NZ(A(APOSM))
-                APOSM = APOSM + N2 - J - 1
-                ILINE = ILINE + LEN
-                IF (ILINE.GT.72) THEN
-                  WRITE (MP,'(A)') LINE
-                  ILINE = 1
-                END IF
-   60         CONTINUE
-              DO 70 J = IROW + 1,N2
-                WRITE (LINE(ILINE:ILINE+LEN-1),'(A)') ' '
-                ILINE = ILINE + LEN
-                IF (ILINE.GT.72) THEN
-                  WRITE (MP,'(A)') LINE
-                  ILINE = 1
-                END IF
-   70         CONTINUE
-              IF (ILINE.GT.1) THEN
-                LINE(ILINE:) = ' '
-                WRITE (MP,'(A)') LINE
-              END IF
-   80       CONTINUE
-            APOS = APOS + (N2* (N2-1))/2
-          END IF
-          ILINE = 1
-          APOS = APOS + N2
-          DO 90 J = 1,NROWS
-            IF (LEN.EQ.12) WRITE (LINE(ILINE:ILINE+11),
-     +          '(1P,D12.4)') A(APOS)
-            IF (LEN.EQ.1) WRITE (LINE(ILINE:ILINE),'(A)') NZ(A(APOS))
-            APOS = APOS + 1
-            ILINE = ILINE + LEN
-            IF (ILINE.GT.72) THEN
-              WRITE (MP,'(A)') LINE
-              ILINE = 1
-            END IF
-            IF (J.EQ.N2) APOS = APOS - NROWS
-   90     CONTINUE
-          APOS = APOS + N2
-          IF (ILINE.GT.1) THEN
-            LINE(ILINE:) = ' '
-            WRITE (MP,'(A)') LINE
-          END IF
-        END IF
-        IWPOS = IWPOS + NROWS
-        IF (LEN.EQ.12) WRITE (MP,'(6I12)') (IW(K),K=IWPOS,
-     +      IWPOS+NCOLS-NROWS-1)
-        IF (LEN.EQ.1) WRITE (MP,'(72A1)') (SGN(IW(K)),K=IWPOS,
-     +      IWPOS+NCOLS-NROWS-1)
-        IWPOS = IWPOS + NCOLS - NROWS
-        DO 280 IROW = 1,NROWS
-          J1 = NROWS
-          J2 = NCOLS
-          IF (KIND.GT.1) THEN
-            IF (IROW.GT.N2) THEN
-              J2 = NCOLS - NUM3
-            ELSE IF (KIND.EQ.3) THEN
-              J1 = NROWS + NUM1
-            END IF
-          END IF
-          ILINE = 1
-          DO 100 J = NROWS + 1,J1
-            IF (LEN.EQ.12) WRITE (LINE(ILINE:ILINE+11),
-     +          '(A)') '  0000000000'
-            IF (LEN.EQ.1) WRITE (LINE(ILINE:ILINE),'(A)') '0'
-            ILINE = ILINE + LEN
-            IF (ILINE.GT.72) THEN
-              WRITE (MP,'(A)') LINE
-              ILINE = 1
-            END IF
-  100     CONTINUE
-          DO 110 J = J1 + 1,J2
-            IF (LEN.EQ.12) WRITE (LINE(ILINE:ILINE+11),
-     +          '(1P,D12.4)') A(APOS)
-            IF (LEN.EQ.1) WRITE (LINE(ILINE:ILINE),'(A)') NZ(A(APOS))
-            APOS = APOS + 1
-            ILINE = ILINE + LEN
-            IF (ILINE.GT.72) THEN
-              WRITE (MP,'(A)') LINE
-              ILINE = 1
-            END IF
-  110     CONTINUE
-          DO 120 J = J2 + 1,NCOLS
-            IF (LEN.EQ.12) WRITE (LINE(ILINE:ILINE+11),
-     +          '(A)') '  0000000000'
-            IF (LEN.EQ.1) WRITE (LINE(ILINE:ILINE),'(A)') '0'
-            ILINE = ILINE + LEN
-            IF (ILINE.GT.72) THEN
-              WRITE (MP,'(A)') LINE
-              ILINE = 1
-            END IF
-  120     CONTINUE
-          IF (ILINE.GT.1) THEN
-            LINE(ILINE:) = ' '
-            WRITE (MP,'(A)') LINE
-          END IF
-  280   CONTINUE
-  300 CONTINUE
-      END
-      SUBROUTINE MA47VD(THRESH,NEWTHR,N,IPE,IW,LW,COUNT,NV,NEXT,LAST,
-     +                  IPR,FLAG,NFLG)
-      INTEGER THRESH,NEWTHR,N,IPE(N),LW,IW(LW),COUNT(N),NV(N),NEXT(N),
-     +        LAST(N),IPR(N),FLAG(N),NFLG
-      EXTERNAL MA47ZD
-      INTEGER IR,IS,JP,JP1,JP2,K,KE,KP,KP2,LS,MS,NS,PART
-      DO 50 MS = 1,N
-        IF (FLAG(MS).LT.0) GO TO 50
-        IF (COUNT(MS).LE.THRESH) GO TO 50
-        IF (COUNT(MS).GT.NEWTHR) GO TO 50
-        IR = 0
-        IF (NFLG.LE.4) CALL MA47ZD(N,FLAG,NFLG)
-        NFLG = NFLG - 1
-        K = IPE(MS)
-        KP2 = K + IW(K)
-        DO 30 KP = K + 1,KP2
-          PART = (IW(KP)-1)/N
-          KE = IW(KP) - PART*N
-          IF (FLAG(KE).EQ.-1) GO TO 30
-          IF (FLAG(KE).LE.-2) THEN
-            JP = IPE(KE)
-            JP1 = JP + 3
-            JP2 = JP + IW(JP)
-            IF (PART.EQ.0) THEN
-            ELSE IF (PART.EQ.2) THEN
-              JP1 = JP1 + IW(JP+1)
-            ELSE
-              JP2 = JP2 - IW(JP+2)
-            END IF
-          ELSE
-            JP1 = KP
-            JP2 = KP2
-          END IF
-          DO 20 JP = JP1,JP2
-            IS = IW(JP)
-            IF (FLAG(IS).GT.NFLG) THEN
-              FLAG(IS) = NFLG
-              IR = IR + ABS(NV(IS))
-            END IF
-   20     CONTINUE
-          IF (JP2.EQ.KP2 .OR. IR.GT.NEWTHR) GO TO 40
-   30   CONTINUE
-   40   IF (IR.NE.COUNT(MS)) THEN
-          NS = NEXT(MS)
-          LS = LAST(MS)
-          NEXT(MS) = 0
-          IF (NS.GT.0) LAST(NS) = LS
-          IF (LS.GT.0) THEN
-            NEXT(LS) = NS
-          ELSE
-            IPR(COUNT(MS)) = NS
-          END IF
-          NS = IPR(IR)
-          IF (NS.GT.0) LAST(NS) = MS
-          NEXT(MS) = NS
-          IPR(IR) = MS
-          LAST(MS) = 0
-          COUNT(MS) = IR
-        END IF
-   50 CONTINUE
-      THRESH = NEWTHR
-      END
-      SUBROUTINE MA47WD(A,LA,IW,LIW,NRLBDU)
-      INTEGER LA,LIW
-      DOUBLE PRECISION A(LA)
-      INTEGER IW(LIW)
-      INTEGER NRLBDU
-      DOUBLE PRECISION ZERO
-      PARAMETER (ZERO=0.0D0)
-      INTEGER APOS,IBLK,IROW,IWPOS,J,JPIV,NCOLS,NROWS,NUM1,NUM3,N2
-      APOS = 1
-      IWPOS = 6
-      DO 40 IBLK = 1,IW(3)
-        NCOLS = IW(IWPOS-2)
-        NROWS = IW(IWPOS-1)
-        N2 = ABS(NROWS)/2
-        IF (NCOLS.GT.0) THEN
-          JPIV = 1
-          DO 30 IROW = 1,NROWS
-            JPIV = JPIV - 1
-            IF (JPIV.EQ.1) GO TO 10
-            IF (IW(IWPOS+IROW-1).LT.0) THEN
-              JPIV = 2
-              NRLBDU = NRLBDU + 1
-              A(NRLBDU) = A(APOS+1)
-              A(APOS+1) = ZERO
-            END IF
-   10       DO 20 J = APOS + 1,APOS + NROWS - IROW
-              A(J) = -A(J)
-   20       CONTINUE
-            APOS = APOS + NROWS - IROW + 1
-   30     CONTINUE
-          APOS = APOS + NROWS* (NCOLS-NROWS)
-        ELSE
-          NCOLS = -NCOLS
-          NUM3 = IW(IWPOS)
-          APOS = APOS - NUM3*N2 - N2* (N2+1)/2 + N2
-          IWPOS = IWPOS + 1
-          IF (NROWS.LT.0) THEN
-            NROWS = -NROWS
-            NUM1 = IW(IWPOS)
-            APOS = APOS - NUM1*N2 - N2* (N2+1)/2 + N2
-            IWPOS = IWPOS + 1
-          END IF
-          APOS = APOS + NROWS* (NCOLS+NCOLS-NROWS+1)/2
-        END IF
-        IWPOS = IWPOS + ABS(NCOLS) + 2
-   40 CONTINUE
-      END
-      SUBROUTINE MA47XD(A,LDA,M,N)
-      INTEGER LDA,M,N
-      DOUBLE PRECISION A(LDA,*)
-      INTEGER I,J
-      DOUBLE PRECISION ZERO
-      PARAMETER (ZERO=0.0D0)
-      DO 20 J = 1,M
-        DO 10 I = J,N
-          A(I,J) = ZERO
-   10   CONTINUE
-   20 CONTINUE
-      RETURN
-      END
-      SUBROUTINE MA47YD(A,LDA,M,N,B,LDB,TRIANG,TRANS)
-      INTEGER LDA,M,N,LDB
-      LOGICAL TRIANG,TRANS
-      DOUBLE PRECISION A(LDA,*),B(LDB,*)
-      INTEGER I,J
-      IF (.NOT.TRIANG) THEN
-        IF (.NOT.TRANS) THEN
-          DO 20 J = 1,M
-            DO 10 I = 1,N
-              B(I,J) = A(I,J)
-   10       CONTINUE
-   20     CONTINUE
-        ELSE
-          DO 40 J = 1,M
-            DO 30 I = 1,N
-              B(J,I) = A(I,J)
-   30       CONTINUE
-   40     CONTINUE
-        END IF
-      ELSE
-        DO 60 J = 1,M
-          DO 50 I = J,N
-            B(I,J) = A(I,J)
-   50     CONTINUE
-   60   CONTINUE
-      END IF
-      RETURN
-      END
-      SUBROUTINE MA47ZD(N,FLAG,NFLG)
-      INTEGER N,FLAG(N),NFLG
-      INTEGER I,N3
-      N3 = N*3
-      DO 80 I = 1,N
-        IF (FLAG(I).GT.2) FLAG(I) = N3
-        IF (FLAG(I).LE.-2) FLAG(I) = -N3
-   80 CONTINUE
-      NFLG = N3
-      END
diff --git a/deal.II/contrib/hsl/source/ma47dep.f b/deal.II/contrib/hsl/source/ma47dep.f
deleted file mode 100644 (file)
index c9ec6f2..0000000
+++ /dev/null
@@ -1,1725 +0,0 @@
-      SUBROUTINE DGEMM ( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB,
-     $                   BETA, C, LDC )
-*     .. Scalar Arguments ..
-      CHARACTER*1        TRANSA, TRANSB
-      INTEGER            M, N, K, LDA, LDB, LDC
-      DOUBLE PRECISION   ALPHA, BETA
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), C( LDC, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGEMM  performs one of the matrix-matrix operations
-*
-*     C := alpha*op( A )*op( B ) + beta*C,
-*
-*  where  op( X ) is one of
-*
-*     op( X ) = X   or   op( X ) = X',
-*
-*  alpha and beta are scalars, and A, B and C are matrices, with op( A )
-*  an m by k matrix,  op( B )  a  k by n matrix and  C an m by n matrix.
-*
-*  Parameters
-*  ==========
-*
-*  TRANSA - CHARACTER*1.
-*           On entry, TRANSA specifies the form of op( A ) to be used in
-*           the matrix multiplication as follows:
-*
-*              TRANSA = 'N' or 'n',  op( A ) = A.
-*
-*              TRANSA = 'T' or 't',  op( A ) = A'.
-*
-*              TRANSA = 'C' or 'c',  op( A ) = A'.
-*
-*           Unchanged on exit.
-*
-*  TRANSB - CHARACTER*1.
-*           On entry, TRANSB specifies the form of op( B ) to be used in
-*           the matrix multiplication as follows:
-*
-*              TRANSB = 'N' or 'n',  op( B ) = B.
-*
-*              TRANSB = 'T' or 't',  op( B ) = B'.
-*
-*              TRANSB = 'C' or 'c',  op( B ) = B'.
-*
-*           Unchanged on exit.
-*
-*  M      - INTEGER.
-*           On entry,  M  specifies  the number  of rows  of the  matrix
-*           op( A )  and of the  matrix  C.  M  must  be at least  zero.
-*           Unchanged on exit.
-*
-*  N      - INTEGER.
-*           On entry,  N  specifies the number  of columns of the matrix
-*           op( B ) and the number of columns of the matrix C. N must be
-*           at least zero.
-*           Unchanged on exit.
-*
-*  K      - INTEGER.
-*           On entry,  K  specifies  the number of columns of the matrix
-*           op( A ) and the number of rows of the matrix op( B ). K must
-*           be at least  zero.
-*           Unchanged on exit.
-*
-*  ALPHA  - DOUBLE PRECISION.
-*           On entry, ALPHA specifies the scalar alpha.
-*           Unchanged on exit.
-*
-*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
-*           k  when  TRANSA = 'N' or 'n',  and is  m  otherwise.
-*           Before entry with  TRANSA = 'N' or 'n',  the leading  m by k
-*           part of the array  A  must contain the matrix  A,  otherwise
-*           the leading  k by m  part of the array  A  must contain  the
-*           matrix A.
-*           Unchanged on exit.
-*
-*  LDA    - INTEGER.
-*           On entry, LDA specifies the first dimension of A as declared
-*           in the calling (sub) program. When  TRANSA = 'N' or 'n' then
-*           LDA must be at least  max( 1, m ), otherwise  LDA must be at
-*           least  max( 1, k ).
-*           Unchanged on exit.
-*
-*  B      - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is
-*           n  when  TRANSB = 'N' or 'n',  and is  k  otherwise.
-*           Before entry with  TRANSB = 'N' or 'n',  the leading  k by n
-*           part of the array  B  must contain the matrix  B,  otherwise
-*           the leading  n by k  part of the array  B  must contain  the
-*           matrix B.
-*           Unchanged on exit.
-*
-*  LDB    - INTEGER.
-*           On entry, LDB specifies the first dimension of B as declared
-*           in the calling (sub) program. When  TRANSB = 'N' or 'n' then
-*           LDB must be at least  max( 1, k ), otherwise  LDB must be at
-*           least  max( 1, n ).
-*           Unchanged on exit.
-*
-*  BETA   - DOUBLE PRECISION.
-*           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
-*           supplied as zero then C need not be set on input.
-*           Unchanged on exit.
-*
-*  C      - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
-*           Before entry, the leading  m by n  part of the array  C must
-*           contain the matrix  C,  except when  beta  is zero, in which
-*           case C need not be set on entry.
-*           On exit, the array  C  is overwritten by the  m by n  matrix
-*           ( alpha*op( A )*op( B ) + beta*C ).
-*
-*  LDC    - INTEGER.
-*           On entry, LDC specifies the first dimension of C as declared
-*           in  the  calling  (sub)  program.   LDC  must  be  at  least
-*           max( 1, m ).
-*           Unchanged on exit.
-*
-*
-*  Level 3 Blas routine.
-*
-*  -- Written on 8-February-1989.
-*     Jack Dongarra, Argonne National Laboratory.
-*     Iain Duff, AERE Harwell.
-*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
-*     Sven Hammarling, Numerical Algorithms Group Ltd.
-*
-*
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     .. Local Scalars ..
-      LOGICAL            NOTA, NOTB
-      INTEGER            I, INFO, J, L, NCOLA, NROWA, NROWB
-      DOUBLE PRECISION   TEMP
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE         , ZERO
-      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Executable Statements ..
-*
-*     Set  NOTA  and  NOTB  as  true if  A  and  B  respectively are not
-*     transposed and set  NROWA, NCOLA and  NROWB  as the number of rows
-*     and  columns of  A  and the  number of  rows  of  B  respectively.
-*
-      NOTA  = LSAME( TRANSA, 'N' )
-      NOTB  = LSAME( TRANSB, 'N' )
-      IF( NOTA )THEN
-         NROWA = M
-         NCOLA = K
-      ELSE
-         NROWA = K
-         NCOLA = M
-      END IF
-      IF( NOTB )THEN
-         NROWB = K
-      ELSE
-         NROWB = N
-      END IF
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      IF(      ( .NOT.NOTA                 ).AND.
-     $         ( .NOT.LSAME( TRANSA, 'C' ) ).AND.
-     $         ( .NOT.LSAME( TRANSA, 'T' ) )      )THEN
-         INFO = 1
-      ELSE IF( ( .NOT.NOTB                 ).AND.
-     $         ( .NOT.LSAME( TRANSB, 'C' ) ).AND.
-     $         ( .NOT.LSAME( TRANSB, 'T' ) )      )THEN
-         INFO = 2
-      ELSE IF( M  .LT.0               )THEN
-         INFO = 3
-      ELSE IF( N  .LT.0               )THEN
-         INFO = 4
-      ELSE IF( K  .LT.0               )THEN
-         INFO = 5
-      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
-         INFO = 8
-      ELSE IF( LDB.LT.MAX( 1, NROWB ) )THEN
-         INFO = 10
-      ELSE IF( LDC.LT.MAX( 1, M     ) )THEN
-         INFO = 13
-      END IF
-      IF( INFO.NE.0 )THEN
-         CALL XERBLA( 'DGEMM ', INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible.
-*
-      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
-     $    ( ( ( ALPHA.EQ.ZERO ).OR.( K.EQ.0 ) ).AND.( BETA.EQ.ONE ) ) )
-     $   RETURN
-*
-*     And if  alpha.eq.zero.
-*
-      IF( ALPHA.EQ.ZERO )THEN
-         IF( BETA.EQ.ZERO )THEN
-            DO 20, J = 1, N
-               DO 10, I = 1, M
-                  C( I, J ) = ZERO
-   10          CONTINUE
-   20       CONTINUE
-         ELSE
-            DO 40, J = 1, N
-               DO 30, I = 1, M
-                  C( I, J ) = BETA*C( I, J )
-   30          CONTINUE
-   40       CONTINUE
-         END IF
-         RETURN
-      END IF
-*
-*     Start the operations.
-*
-      IF( NOTB )THEN
-         IF( NOTA )THEN
-*
-*           Form  C := alpha*A*B + beta*C.
-*
-            DO 90, J = 1, N
-               IF( BETA.EQ.ZERO )THEN
-                  DO 50, I = 1, M
-                     C( I, J ) = ZERO
-   50             CONTINUE
-               ELSE IF( BETA.NE.ONE )THEN
-                  DO 60, I = 1, M
-                     C( I, J ) = BETA*C( I, J )
-   60             CONTINUE
-               END IF
-               DO 80, L = 1, K
-                  IF( B( L, J ).NE.ZERO )THEN
-                     TEMP = ALPHA*B( L, J )
-                     DO 70, I = 1, M
-                        C( I, J ) = C( I, J ) + TEMP*A( I, L )
-   70                CONTINUE
-                  END IF
-   80          CONTINUE
-   90       CONTINUE
-         ELSE
-*
-*           Form  C := alpha*A'*B + beta*C
-*
-            DO 120, J = 1, N
-               DO 110, I = 1, M
-                  TEMP = ZERO
-                  DO 100, L = 1, K
-                     TEMP = TEMP + A( L, I )*B( L, J )
-  100             CONTINUE
-                  IF( BETA.EQ.ZERO )THEN
-                     C( I, J ) = ALPHA*TEMP
-                  ELSE
-                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
-                  END IF
-  110          CONTINUE
-  120       CONTINUE
-         END IF
-      ELSE
-         IF( NOTA )THEN
-*
-*           Form  C := alpha*A*B' + beta*C
-*
-            DO 170, J = 1, N
-               IF( BETA.EQ.ZERO )THEN
-                  DO 130, I = 1, M
-                     C( I, J ) = ZERO
-  130             CONTINUE
-               ELSE IF( BETA.NE.ONE )THEN
-                  DO 140, I = 1, M
-                     C( I, J ) = BETA*C( I, J )
-  140             CONTINUE
-               END IF
-               DO 160, L = 1, K
-                  IF( B( J, L ).NE.ZERO )THEN
-                     TEMP = ALPHA*B( J, L )
-                     DO 150, I = 1, M
-                        C( I, J ) = C( I, J ) + TEMP*A( I, L )
-  150                CONTINUE
-                  END IF
-  160          CONTINUE
-  170       CONTINUE
-         ELSE
-*
-*           Form  C := alpha*A'*B' + beta*C
-*
-            DO 200, J = 1, N
-               DO 190, I = 1, M
-                  TEMP = ZERO
-                  DO 180, L = 1, K
-                     TEMP = TEMP + A( L, I )*B( J, L )
-  180             CONTINUE
-                  IF( BETA.EQ.ZERO )THEN
-                     C( I, J ) = ALPHA*TEMP
-                  ELSE
-                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
-                  END IF
-  190          CONTINUE
-  200       CONTINUE
-         END IF
-      END IF
-*
-      RETURN
-*
-*     End of DGEMM .
-*
-      END
-      SUBROUTINE DGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX,
-*
-************************************************************************
-*
-*     File of the DOUBLE PRECISION  Level-2 BLAS.
-*     ===========================================
-*
-*     SUBROUTINE DGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX,
-*    $                   BETA, Y, INCY )
-*
-*     SUBROUTINE DGBMV ( TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX,
-*    $                   BETA, Y, INCY )
-*
-*     SUBROUTINE DSYMV ( UPLO, N, ALPHA, A, LDA, X, INCX,
-*    $                   BETA, Y, INCY )
-*
-*     SUBROUTINE DSBMV ( UPLO, N, K, ALPHA, A, LDA, X, INCX,
-*    $                   BETA, Y, INCY )
-*
-*     SUBROUTINE DSPMV ( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY )
-*
-*     SUBROUTINE DTRMV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
-*
-*     SUBROUTINE DTBMV ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX )
-*
-*     SUBROUTINE DTPMV ( UPLO, TRANS, DIAG, N, AP, X, INCX )
-*
-*     SUBROUTINE DTRSV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
-*
-*     SUBROUTINE DTBSV ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX )
-*
-*     SUBROUTINE DTPSV ( UPLO, TRANS, DIAG, N, AP, X, INCX )
-*
-*     SUBROUTINE DGER  ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
-*
-*     SUBROUTINE DSYR  ( UPLO, N, ALPHA, X, INCX, A, LDA )
-*
-*     SUBROUTINE DSPR  ( UPLO, N, ALPHA, X, INCX, AP )
-*
-*     SUBROUTINE DSYR2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA )
-*
-*     SUBROUTINE DSPR2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, AP )
-*
-*     See:
-*
-*        Dongarra J. J., Du Croz J. J., Hammarling S.  and Hanson R. J..
-*        An  extended  set of Fortran  Basic Linear Algebra Subprograms.
-*
-*        Technical  Memoranda  Nos. 41 (revision 3) and 81,  Mathematics
-*        and  Computer Science  Division,  Argonne  National Laboratory,
-*        9700 South Cass Avenue, Argonne, Illinois 60439, US.
-*
-*        Or
-*
-*        NAG  Technical Reports TR3/87 and TR4/87,  Numerical Algorithms
-*        Group  Ltd.,  NAG  Central  Office,  256  Banbury  Road, Oxford
-*        OX2 7DE, UK,  and  Numerical Algorithms Group Inc.,  1101  31st
-*        Street,  Suite 100,  Downers Grove,  Illinois 60515-1263,  USA.
-*
-************************************************************************
-*
-     $                   BETA, Y, INCY )
-*     .. Scalar Arguments ..
-      DOUBLE PRECISION   ALPHA, BETA
-      INTEGER            INCX, INCY, LDA, M, N
-      CHARACTER*1        TRANS
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), X( * ), Y( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGEMV  performs one of the matrix-vector operations
-*
-*     y := alpha*A*x + beta*y,   or   y := alpha*A'*x + beta*y,
-*
-*  where alpha and beta are scalars, x and y are vectors and A is an
-*  m by n matrix.
-*
-*  Parameters
-*  ==========
-*
-*  TRANS  - CHARACTER*1.
-*           On entry, TRANS specifies the operation to be performed as
-*           follows:
-*
-*              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
-*
-*              TRANS = 'T' or 't'   y := alpha*A'*x + beta*y.
-*
-*              TRANS = 'C' or 'c'   y := alpha*A'*x + beta*y.
-*
-*           Unchanged on exit.
-*
-*  M      - INTEGER.
-*           On entry, M specifies the number of rows of the matrix A.
-*           M must be at least zero.
-*           Unchanged on exit.
-*
-*  N      - INTEGER.
-*           On entry, N specifies the number of columns of the matrix A.
-*           N must be at least zero.
-*           Unchanged on exit.
-*
-*  ALPHA  - DOUBLE PRECISION.
-*           On entry, ALPHA specifies the scalar alpha.
-*           Unchanged on exit.
-*
-*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-*           Before entry, the leading m by n part of the array A must
-*           contain the matrix of coefficients.
-*           Unchanged on exit.
-*
-*  LDA    - INTEGER.
-*           On entry, LDA specifies the first dimension of A as declared
-*           in the calling (sub) program. LDA must be at least
-*           max( 1, m ).
-*           Unchanged on exit.
-*
-*  X      - DOUBLE PRECISION array of DIMENSION at least
-*           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
-*           and at least
-*           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
-*           Before entry, the incremented array X must contain the
-*           vector x.
-*           Unchanged on exit.
-*
-*  INCX   - INTEGER.
-*           On entry, INCX specifies the increment for the elements of
-*           X. INCX must not be zero.
-*           Unchanged on exit.
-*
-*  BETA   - DOUBLE PRECISION.
-*           On entry, BETA specifies the scalar beta. When BETA is
-*           supplied as zero then Y need not be set on input.
-*           Unchanged on exit.
-*
-*  Y      - DOUBLE PRECISION array of DIMENSION at least
-*           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
-*           and at least
-*           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
-*           Before entry with BETA non-zero, the incremented array Y
-*           must contain the vector y. On exit, Y is overwritten by the
-*           updated vector y.
-*
-*  INCY   - INTEGER.
-*           On entry, INCY specifies the increment for the elements of
-*           Y. INCY must not be zero.
-*           Unchanged on exit.
-*
-*
-*  Level 2 Blas routine.
-*
-*  -- Written on 22-October-1986.
-*     Jack Dongarra, Argonne National Lab.
-*     Jeremy Du Croz, Nag Central Office.
-*     Sven Hammarling, Nag Central Office.
-*     Richard Hanson, Sandia National Labs.
-*
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE         , ZERO
-      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     .. Local Scalars ..
-      DOUBLE PRECISION   TEMP
-      INTEGER            I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      IF     ( .NOT.LSAME( TRANS, 'N' ).AND.
-     $         .NOT.LSAME( TRANS, 'T' ).AND.
-     $         .NOT.LSAME( TRANS, 'C' )      )THEN
-         INFO = 1
-      ELSE IF( M.LT.0 )THEN
-         INFO = 2
-      ELSE IF( N.LT.0 )THEN
-         INFO = 3
-      ELSE IF( LDA.LT.MAX( 1, M ) )THEN
-         INFO = 6
-      ELSE IF( INCX.EQ.0 )THEN
-         INFO = 8
-      ELSE IF( INCY.EQ.0 )THEN
-         INFO = 11
-      END IF
-      IF( INFO.NE.0 )THEN
-         CALL XERBLA( 'DGEMV ', INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible.
-*
-      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
-     $    ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
-     $   RETURN
-*
-*     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
-*     up the start points in  X  and  Y.
-*
-      IF( LSAME( TRANS, 'N' ) )THEN
-         LENX = N
-         LENY = M
-      ELSE
-         LENX = M
-         LENY = N
-      END IF
-      IF( INCX.GT.0 )THEN
-         KX = 1
-      ELSE
-         KX = 1 - ( LENX - 1 )*INCX
-      END IF
-      IF( INCY.GT.0 )THEN
-         KY = 1
-      ELSE
-         KY = 1 - ( LENY - 1 )*INCY
-      END IF
-*
-*     Start the operations. In this version the elements of A are
-*     accessed sequentially with one pass through A.
-*
-*     First form  y := beta*y.
-*
-      IF( BETA.NE.ONE )THEN
-         IF( INCY.EQ.1 )THEN
-            IF( BETA.EQ.ZERO )THEN
-               DO 10, I = 1, LENY
-                  Y( I ) = ZERO
-   10          CONTINUE
-            ELSE
-               DO 20, I = 1, LENY
-                  Y( I ) = BETA*Y( I )
-   20          CONTINUE
-            END IF
-         ELSE
-            IY = KY
-            IF( BETA.EQ.ZERO )THEN
-               DO 30, I = 1, LENY
-                  Y( IY ) = ZERO
-                  IY      = IY   + INCY
-   30          CONTINUE
-            ELSE
-               DO 40, I = 1, LENY
-                  Y( IY ) = BETA*Y( IY )
-                  IY      = IY           + INCY
-   40          CONTINUE
-            END IF
-         END IF
-      END IF
-      IF( ALPHA.EQ.ZERO )
-     $   RETURN
-      IF( LSAME( TRANS, 'N' ) )THEN
-*
-*        Form  y := alpha*A*x + y.
-*
-         JX = KX
-         IF( INCY.EQ.1 )THEN
-            DO 60, J = 1, N
-               IF( X( JX ).NE.ZERO )THEN
-                  TEMP = ALPHA*X( JX )
-                  DO 50, I = 1, M
-                     Y( I ) = Y( I ) + TEMP*A( I, J )
-   50             CONTINUE
-               END IF
-               JX = JX + INCX
-   60       CONTINUE
-         ELSE
-            DO 80, J = 1, N
-               IF( X( JX ).NE.ZERO )THEN
-                  TEMP = ALPHA*X( JX )
-                  IY   = KY
-                  DO 70, I = 1, M
-                     Y( IY ) = Y( IY ) + TEMP*A( I, J )
-                     IY      = IY      + INCY
-   70             CONTINUE
-               END IF
-               JX = JX + INCX
-   80       CONTINUE
-         END IF
-      ELSE
-*
-*        Form  y := alpha*A'*x + y.
-*
-         JY = KY
-         IF( INCX.EQ.1 )THEN
-            DO 100, J = 1, N
-               TEMP = ZERO
-               DO 90, I = 1, M
-                  TEMP = TEMP + A( I, J )*X( I )
-   90          CONTINUE
-               Y( JY ) = Y( JY ) + ALPHA*TEMP
-               JY      = JY      + INCY
-  100       CONTINUE
-         ELSE
-            DO 120, J = 1, N
-               TEMP = ZERO
-               IX   = KX
-               DO 110, I = 1, M
-                  TEMP = TEMP + A( I, J )*X( IX )
-                  IX   = IX   + INCX
-  110          CONTINUE
-               Y( JY ) = Y( JY ) + ALPHA*TEMP
-               JY      = JY      + INCY
-  120       CONTINUE
-         END IF
-      END IF
-*
-      RETURN
-*
-*     End of DGEMV .
-*
-      END
-      LOGICAL FUNCTION LSAME ( CA, CB )
-*     .. Scalar Arguments ..
-      CHARACTER*1            CA, CB
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  LSAME  tests if CA is the same letter as CB regardless of case.
-*
-*  N.B. This version of the routine is only correct for ASCII code.
-*       Installers must modify the routine for other character-codes.
-*
-*       For EBCDIC systems the constant IOFF must be changed to -64.
-*       For CDC systems using 6-12 bit representations, the system-
-*       specific code in comments must be activated.
-*
-*  Parameters
-*  ==========
-*
-*  CA     - CHARACTER*1
-*  CB     - CHARACTER*1
-*           On entry, CA and CB specify characters to be compared.
-*           Unchanged on exit.
-*
-*
-*  Auxiliary routine for Level 2 Blas.
-*
-*  -- Written on 11-October-1988.
-*     Richard Hanson, Sandia National Labs.
-*     Jeremy Du Croz, Nag Central Office.
-*
-*     .. Parameters ..
-      INTEGER                IOFF
-      PARAMETER            ( IOFF=32 )
-*     .. Intrinsic Functions ..
-      INTRINSIC              ICHAR
-*     .. Executable Statements ..
-*
-*     Test if the characters are equal
-*
-      LSAME = CA .EQ. CB
-*
-*     Now test for equivalence
-*
-      IF ( .NOT.LSAME ) THEN
-         LSAME = ICHAR(CA) - IOFF .EQ. ICHAR(CB)
-      END IF
-      IF ( .NOT.LSAME ) THEN
-         LSAME = ICHAR(CA) .EQ. ICHAR(CB) - IOFF
-      END IF
-*
-      RETURN
-*
-*  The following comments contain code for CDC systems using 6-12 bit
-*  representations.
-*
-*     .. Parameters ..
-*     INTEGER                ICIRFX
-*     PARAMETER            ( ICIRFX=62 )
-*     .. Scalar Arguments ..
-*     CHARACTER*1            CB
-*     .. Array Arguments ..
-*     CHARACTER*1            CA(*)
-*     .. Local Scalars ..
-*     INTEGER                IVAL
-*     .. Intrinsic Functions ..
-*     INTRINSIC              ICHAR, CHAR
-*     .. Executable Statements ..
-*
-*     See if the first character in string CA equals string CB.
-*
-*     LSAME = CA(1) .EQ. CB .AND. CA(1) .NE. CHAR(ICIRFX)
-*
-*     IF (LSAME) RETURN
-*
-*     The characters are not identical. Now check them for equivalence.
-*     Look for the 'escape' character, circumflex, followed by the
-*     letter.
-*
-*     IVAL = ICHAR(CA(2))
-*     IF (IVAL.GE.ICHAR('A') .AND. IVAL.LE.ICHAR('Z')) THEN
-*        LSAME = CA(1) .EQ. CHAR(ICIRFX) .AND. CA(2) .EQ. CB
-*     END IF
-*
-*     RETURN
-*
-*     End of LSAME.
-*
-      END
-C       A BLAS routine modified for use with HSL
-C       Toolpack tool decs employed.
-C       Contained comment lines which caused Decs to fail.
-C
-      SUBROUTINE XERBLA(SRNAME,INFO)
-C     .. Scalar Arguments ..
-      INTEGER INFO
-      CHARACTER SRNAME*6
-C     ..
-C
-C  Purpose
-C  =======
-C
-C  XERBLA  is an error handler for the Level 2 BLAS routines.
-C
-C  It is called by the Level 2 BLAS routines if an input parameter is
-C  invalid.
-C
-C  Installers should consider modifying the STOP statement in order to
-C  call system-specific exception-handling facilities.
-C
-C  Parameters
-C  ==========
-C
-C  SRNAME - CHARACTER*6.
-C           On entry, SRNAME specifies the name of the routine which
-C           called XERBLA.
-C
-C  INFO   - INTEGER.
-C           On entry, INFO specifies the position of the invalid
-C           parameter in the parameter-list of the calling routine.
-C
-C
-C  Auxiliary routine for Level 2 Blas.
-C
-C  Written on 20-July-1986.
-C
-C     .. Executable Statements ..
-C
-      WRITE (*,FMT=99999) SRNAME,INFO
-C
-      STOP
-C
-99999 FORMAT (' ** On entry to ',A6,' parameter number ',I2,
-     +       ' had an illegal value')
-C
-C     End of XERBLA.
-C
-      END
-C       Toolpack tool decs employed.
-C       Arg dimension set to *.
-C
-      INTEGER FUNCTION IDAMAX(N,DX,INCX)
-C
-C     FINDS THE INDEX OF ELEMENT HAVING MAX. ABSOLUTE VALUE.
-C     JACK DONGARRA, LINPACK, 3/11/78.
-C
-C     .. Scalar Arguments ..
-      INTEGER INCX,N
-C     ..
-C     .. Array Arguments ..
-      DOUBLE PRECISION DX(*)
-C     ..
-C     .. Local Scalars ..
-      DOUBLE PRECISION DMAX
-      INTEGER I,IX
-C     ..
-C     .. Intrinsic Functions ..
-      INTRINSIC DABS
-C     ..
-C     .. Executable Statements ..
-C
-      IDAMAX = 0
-      IF (N.LT.1) RETURN
-      IDAMAX = 1
-      IF (N.EQ.1) RETURN
-      IF (INCX.EQ.1) GO TO 20
-C
-C        CODE FOR INCREMENT NOT EQUAL TO 1
-C
-      IX = 1
-      DMAX = DABS(DX(1))
-      IX = IX + INCX
-      DO 10 I = 2,N
-        IF (DABS(DX(IX)).LE.DMAX) GO TO 5
-        IDAMAX = I
-        DMAX = DABS(DX(IX))
-    5   IX = IX + INCX
-   10 CONTINUE
-      RETURN
-C
-C        CODE FOR INCREMENT EQUAL TO 1
-C
-   20 DMAX = DABS(DX(1))
-      DO 30 I = 2,N
-        IF (DABS(DX(I)).LE.DMAX) GO TO 30
-        IDAMAX = I
-        DMAX = DABS(DX(I))
-   30 CONTINUE
-      RETURN
-
-      END
-      SUBROUTINE DTPMV ( UPLO, TRANS, DIAG, N, AP, X, INCX )
-*
-************************************************************************
-*
-*     .. Scalar Arguments ..
-      INTEGER            INCX, N
-      CHARACTER*1        DIAG, TRANS, UPLO
-*     .. Array Arguments ..
-      DOUBLE PRECISION   AP( * ), X( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DTPMV  performs one of the matrix-vector operations
-*
-*     x := A*x,   or   x := A'*x,
-*
-*  where x is an n element vector and  A is an n by n unit, or non-unit,
-*  upper or lower triangular matrix, supplied in packed form.
-*
-*  Parameters
-*  ==========
-*
-*  UPLO   - CHARACTER*1.
-*           On entry, UPLO specifies whether the matrix is an upper or
-*           lower triangular matrix as follows:
-*
-*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
-*
-*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
-*
-*           Unchanged on exit.
-*
-*  TRANS  - CHARACTER*1.
-*           On entry, TRANS specifies the operation to be performed as
-*           follows:
-*
-*              TRANS = 'N' or 'n'   x := A*x.
-*
-*              TRANS = 'T' or 't'   x := A'*x.
-*
-*              TRANS = 'C' or 'c'   x := A'*x.
-*
-*           Unchanged on exit.
-*
-*  DIAG   - CHARACTER*1.
-*           On entry, DIAG specifies whether or not A is unit
-*           triangular as follows:
-*
-*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
-*
-*              DIAG = 'N' or 'n'   A is not assumed to be unit
-*                                  triangular.
-*
-*           Unchanged on exit.
-*
-*  N      - INTEGER.
-*           On entry, N specifies the order of the matrix A.
-*           N must be at least zero.
-*           Unchanged on exit.
-*
-*  AP     - DOUBLE PRECISION array of DIMENSION at least
-*           ( ( n*( n + 1 ) )/2 ).
-*           Before entry with  UPLO = 'U' or 'u', the array AP must
-*           contain the upper triangular matrix packed sequentially,
-*           column by column, so that AP( 1 ) contains a( 1, 1 ),
-*           AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
-*           respectively, and so on.
-*           Before entry with UPLO = 'L' or 'l', the array AP must
-*           contain the lower triangular matrix packed sequentially,
-*           column by column, so that AP( 1 ) contains a( 1, 1 ),
-*           AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
-*           respectively, and so on.
-*           Note that when  DIAG = 'U' or 'u', the diagonal elements of
-*           A are not referenced, but are assumed to be unity.
-*           Unchanged on exit.
-*
-*  X      - DOUBLE PRECISION array of dimension at least
-*           ( 1 + ( n - 1 )*abs( INCX ) ).
-*           Before entry, the incremented array X must contain the n
-*           element vector x. On exit, X is overwritten with the
-*           tranformed vector x.
-*
-*  INCX   - INTEGER.
-*           On entry, INCX specifies the increment for the elements of
-*           X. INCX must not be zero.
-*           Unchanged on exit.
-*
-*
-*  Level 2 Blas routine.
-*
-*  -- Written on 22-October-1986.
-*     Jack Dongarra, Argonne National Lab.
-*     Jeremy Du Croz, Nag Central Office.
-*     Sven Hammarling, Nag Central Office.
-*     Richard Hanson, Sandia National Labs.
-*
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER        ( ZERO = 0.0D+0 )
-*     .. Local Scalars ..
-      DOUBLE PRECISION   TEMP
-      INTEGER            I, INFO, IX, J, JX, K, KK, KX
-      LOGICAL            NOUNIT
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      IF     ( .NOT.LSAME( UPLO , 'U' ).AND.
-     $         .NOT.LSAME( UPLO , 'L' )      )THEN
-         INFO = 1
-      ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
-     $         .NOT.LSAME( TRANS, 'T' ).AND.
-     $         .NOT.LSAME( TRANS, 'C' )      )THEN
-         INFO = 2
-      ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
-     $         .NOT.LSAME( DIAG , 'N' )      )THEN
-         INFO = 3
-      ELSE IF( N.LT.0 )THEN
-         INFO = 4
-      ELSE IF( INCX.EQ.0 )THEN
-         INFO = 7
-      END IF
-      IF( INFO.NE.0 )THEN
-         CALL XERBLA( 'DTPMV ', INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible.
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-      NOUNIT = LSAME( DIAG, 'N' )
-*
-*     Set up the start point in X if the increment is not unity. This
-*     will be  ( N - 1 )*INCX  too small for descending loops.
-*
-      IF( INCX.LE.0 )THEN
-         KX = 1 - ( N - 1 )*INCX
-      ELSE IF( INCX.NE.1 )THEN
-         KX = 1
-      END IF
-*
-*     Start the operations. In this version the elements of AP are
-*     accessed sequentially with one pass through AP.
-*
-      IF( LSAME( TRANS, 'N' ) )THEN
-*
-*        Form  x:= A*x.
-*
-         IF( LSAME( UPLO, 'U' ) )THEN
-            KK =1
-            IF( INCX.EQ.1 )THEN
-               DO 20, J = 1, N
-                  IF( X( J ).NE.ZERO )THEN
-                     TEMP = X( J )
-                     K    = KK
-                     DO 10, I = 1, J - 1
-                        X( I ) = X( I ) + TEMP*AP( K )
-                        K      = K      + 1
-   10                CONTINUE
-                     IF( NOUNIT )
-     $                  X( J ) = X( J )*AP( KK + J - 1 )
-                  END IF
-                  KK = KK + J
-   20          CONTINUE
-            ELSE
-               JX = KX
-               DO 40, J = 1, N
-                  IF( X( JX ).NE.ZERO )THEN
-                     TEMP = X( JX )
-                     IX   = KX
-                     DO 30, K = KK, KK + J - 2
-                        X( IX ) = X( IX ) + TEMP*AP( K )
-                        IX      = IX      + INCX
-   30                CONTINUE
-                     IF( NOUNIT )
-     $                  X( JX ) = X( JX )*AP( KK + J - 1 )
-                  END IF
-                  JX = JX + INCX
-                  KK = KK + J
-   40          CONTINUE
-            END IF
-         ELSE
-            KK = ( N*( N + 1 ) )/2
-            IF( INCX.EQ.1 )THEN
-               DO 60, J = N, 1, -1
-                  IF( X( J ).NE.ZERO )THEN
-                     TEMP = X( J )
-                     K    = KK
-                     DO 50, I = N, J + 1, -1
-                        X( I ) = X( I ) + TEMP*AP( K )
-                        K      = K      - 1
-   50                CONTINUE
-                     IF( NOUNIT )
-     $                  X( J ) = X( J )*AP( KK - N + J )
-                  END IF
-                  KK = KK - ( N - J + 1 )
-   60          CONTINUE
-            ELSE
-               KX = KX + ( N - 1 )*INCX
-               JX = KX
-               DO 80, J = N, 1, -1
-                  IF( X( JX ).NE.ZERO )THEN
-                     TEMP = X( JX )
-                     IX   = KX
-                     DO 70, K = KK, KK - ( N - ( J + 1 ) ), -1
-                        X( IX ) = X( IX ) + TEMP*AP( K )
-                        IX      = IX      - INCX
-   70                CONTINUE
-                     IF( NOUNIT )
-     $                  X( JX ) = X( JX )*AP( KK - N + J )
-                  END IF
-                  JX = JX - INCX
-                  KK = KK - ( N - J + 1 )
-   80          CONTINUE
-            END IF
-         END IF
-      ELSE
-*
-*        Form  x := A'*x.
-*
-         IF( LSAME( UPLO, 'U' ) )THEN
-            KK = ( N*( N + 1 ) )/2
-            IF( INCX.EQ.1 )THEN
-               DO 100, J = N, 1, -1
-                  TEMP = X( J )
-                  IF( NOUNIT )
-     $               TEMP = TEMP*AP( KK )
-                  K = KK - 1
-                  DO 90, I = J - 1, 1, -1
-                     TEMP = TEMP + AP( K )*X( I )
-                     K    = K    - 1
-   90             CONTINUE
-                  X( J ) = TEMP
-                  KK     = KK   - J
-  100          CONTINUE
-            ELSE
-               JX = KX + ( N - 1 )*INCX
-               DO 120, J = N, 1, -1
-                  TEMP = X( JX )
-                  IX   = JX
-                  IF( NOUNIT )
-     $               TEMP = TEMP*AP( KK )
-                  DO 110, K = KK - 1, KK - J + 1, -1
-                     IX   = IX   - INCX
-                     TEMP = TEMP + AP( K )*X( IX )
-  110             CONTINUE
-                  X( JX ) = TEMP
-                  JX      = JX   - INCX
-                  KK      = KK   - J
-  120          CONTINUE
-            END IF
-         ELSE
-            KK = 1
-            IF( INCX.EQ.1 )THEN
-               DO 140, J = 1, N
-                  TEMP = X( J )
-                  IF( NOUNIT )
-     $               TEMP = TEMP*AP( KK )
-                  K = KK + 1
-                  DO 130, I = J + 1, N
-                     TEMP = TEMP + AP( K )*X( I )
-                     K    = K    + 1
-  130             CONTINUE
-                  X( J ) = TEMP
-                  KK     = KK   + ( N - J + 1 )
-  140          CONTINUE
-            ELSE
-               JX = KX
-               DO 160, J = 1, N
-                  TEMP = X( JX )
-                  IX   = JX
-                  IF( NOUNIT )
-     $               TEMP = TEMP*AP( KK )
-                  DO 150, K = KK + 1, KK + N - J
-                     IX   = IX   + INCX
-                     TEMP = TEMP + AP( K )*X( IX )
-  150             CONTINUE
-                  X( JX ) = TEMP
-                  JX      = JX   + INCX
-                  KK      = KK   + ( N - J + 1 )
-  160          CONTINUE
-            END IF
-         END IF
-      END IF
-*
-      RETURN
-*
-*     End of DTPMV .
-*
-      END
-      SUBROUTINE DTPSV ( UPLO, TRANS, DIAG, N, AP, X, INCX )
-*
-************************************************************************
-*
-*     .. Scalar Arguments ..
-      INTEGER            INCX, N
-      CHARACTER*1        DIAG, TRANS, UPLO
-*     .. Array Arguments ..
-      DOUBLE PRECISION   AP( * ), X( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DTPSV  solves one of the systems of equations
-*
-*     A*x = b,   or   A'*x = b,
-*
-*  where b and x are n element vectors and A is an n by n unit, or
-*  non-unit, upper or lower triangular matrix, supplied in packed form.
-*
-*  No test for singularity or near-singularity is included in this
-*  routine. Such tests must be performed before calling this routine.
-*
-*  Parameters
-*  ==========
-*
-*  UPLO   - CHARACTER*1.
-*           On entry, UPLO specifies whether the matrix is an upper or
-*           lower triangular matrix as follows:
-*
-*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
-*
-*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
-*
-*           Unchanged on exit.
-*
-*  TRANS  - CHARACTER*1.
-*           On entry, TRANS specifies the equations to be solved as
-*           follows:
-*
-*              TRANS = 'N' or 'n'   A*x = b.
-*
-*              TRANS = 'T' or 't'   A'*x = b.
-*
-*              TRANS = 'C' or 'c'   A'*x = b.
-*
-*           Unchanged on exit.
-*
-*  DIAG   - CHARACTER*1.
-*           On entry, DIAG specifies whether or not A is unit
-*           triangular as follows:
-*
-*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
-*
-*              DIAG = 'N' or 'n'   A is not assumed to be unit
-*                                  triangular.
-*
-*           Unchanged on exit.
-*
-*  N      - INTEGER.
-*           On entry, N specifies the order of the matrix A.
-*           N must be at least zero.
-*           Unchanged on exit.
-*
-*  AP     - DOUBLE PRECISION array of DIMENSION at least
-*           ( ( n*( n + 1 ) )/2 ).
-*           Before entry with  UPLO = 'U' or 'u', the array AP must
-*           contain the upper triangular matrix packed sequentially,
-*           column by column, so that AP( 1 ) contains a( 1, 1 ),
-*           AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
-*           respectively, and so on.
-*           Before entry with UPLO = 'L' or 'l', the array AP must
-*           contain the lower triangular matrix packed sequentially,
-*           column by column, so that AP( 1 ) contains a( 1, 1 ),
-*           AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
-*           respectively, and so on.
-*           Note that when  DIAG = 'U' or 'u', the diagonal elements of
-*           A are not referenced, but are assumed to be unity.
-*           Unchanged on exit.
-*
-*  X      - DOUBLE PRECISION array of dimension at least
-*           ( 1 + ( n - 1 )*abs( INCX ) ).
-*           Before entry, the incremented array X must contain the n
-*           element right-hand side vector b. On exit, X is overwritten
-*           with the solution vector x.
-*
-*  INCX   - INTEGER.
-*           On entry, INCX specifies the increment for the elements of
-*           X. INCX must not be zero.
-*           Unchanged on exit.
-*
-*
-*  Level 2 Blas routine.
-*
-*  -- Written on 22-October-1986.
-*     Jack Dongarra, Argonne National Lab.
-*     Jeremy Du Croz, Nag Central Office.
-*     Sven Hammarling, Nag Central Office.
-*     Richard Hanson, Sandia National Labs.
-*
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER        ( ZERO = 0.0D+0 )
-*     .. Local Scalars ..
-      DOUBLE PRECISION   TEMP
-      INTEGER            I, INFO, IX, J, JX, K, KK, KX
-      LOGICAL            NOUNIT
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      IF     ( .NOT.LSAME( UPLO , 'U' ).AND.
-     $         .NOT.LSAME( UPLO , 'L' )      )THEN
-         INFO = 1
-      ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
-     $         .NOT.LSAME( TRANS, 'T' ).AND.
-     $         .NOT.LSAME( TRANS, 'C' )      )THEN
-         INFO = 2
-      ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
-     $         .NOT.LSAME( DIAG , 'N' )      )THEN
-         INFO = 3
-      ELSE IF( N.LT.0 )THEN
-         INFO = 4
-      ELSE IF( INCX.EQ.0 )THEN
-         INFO = 7
-      END IF
-      IF( INFO.NE.0 )THEN
-         CALL XERBLA( 'DTPSV ', INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible.
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-      NOUNIT = LSAME( DIAG, 'N' )
-*
-*     Set up the start point in X if the increment is not unity. This
-*     will be  ( N - 1 )*INCX  too small for descending loops.
-*
-      IF( INCX.LE.0 )THEN
-         KX = 1 - ( N - 1 )*INCX
-      ELSE IF( INCX.NE.1 )THEN
-         KX = 1
-      END IF
-*
-*     Start the operations. In this version the elements of AP are
-*     accessed sequentially with one pass through AP.
-*
-      IF( LSAME( TRANS, 'N' ) )THEN
-*
-*        Form  x := inv( A )*x.
-*
-         IF( LSAME( UPLO, 'U' ) )THEN
-            KK = ( N*( N + 1 ) )/2
-            IF( INCX.EQ.1 )THEN
-               DO 20, J = N, 1, -1
-                  IF( X( J ).NE.ZERO )THEN
-                     IF( NOUNIT )
-     $                  X( J ) = X( J )/AP( KK )
-                     TEMP = X( J )
-                     K    = KK     - 1
-                     DO 10, I = J - 1, 1, -1
-                        X( I ) = X( I ) - TEMP*AP( K )
-                        K      = K      - 1
-   10                CONTINUE
-                  END IF
-                  KK = KK - J
-   20          CONTINUE
-            ELSE
-               JX = KX + ( N - 1 )*INCX
-               DO 40, J = N, 1, -1
-                  IF( X( JX ).NE.ZERO )THEN
-                     IF( NOUNIT )
-     $                  X( JX ) = X( JX )/AP( KK )
-                     TEMP = X( JX )
-                     IX   = JX
-                     DO 30, K = KK - 1, KK - J + 1, -1
-                        IX      = IX      - INCX
-                        X( IX ) = X( IX ) - TEMP*AP( K )
-   30                CONTINUE
-                  END IF
-                  JX = JX - INCX
-                  KK = KK - J
-   40          CONTINUE
-            END IF
-         ELSE
-            KK = 1
-            IF( INCX.EQ.1 )THEN
-               DO 60, J = 1, N
-                  IF( X( J ).NE.ZERO )THEN
-                     IF( NOUNIT )
-     $                  X( J ) = X( J )/AP( KK )
-                     TEMP = X( J )
-                     K    = KK     + 1
-                     DO 50, I = J + 1, N
-                        X( I ) = X( I ) - TEMP*AP( K )
-                        K      = K      + 1
-   50                CONTINUE
-                  END IF
-                  KK = KK + ( N - J + 1 )
-   60          CONTINUE
-            ELSE
-               JX = KX
-               DO 80, J = 1, N
-                  IF( X( JX ).NE.ZERO )THEN
-                     IF( NOUNIT )
-     $                  X( JX ) = X( JX )/AP( KK )
-                     TEMP = X( JX )
-                     IX   = JX
-                     DO 70, K = KK + 1, KK + N - J
-                        IX      = IX      + INCX
-                        X( IX ) = X( IX ) - TEMP*AP( K )
-   70                CONTINUE
-                  END IF
-                  JX = JX + INCX
-                  KK = KK + ( N - J + 1 )
-   80          CONTINUE
-            END IF
-         END IF
-      ELSE
-*
-*        Form  x := inv( A' )*x.
-*
-         IF( LSAME( UPLO, 'U' ) )THEN
-            KK = 1
-            IF( INCX.EQ.1 )THEN
-               DO 100, J = 1, N
-                  TEMP = X( J )
-                  K    = KK
-                  DO 90, I = 1, J - 1
-                     TEMP = TEMP - AP( K )*X( I )
-                     K    = K    + 1
-   90             CONTINUE
-                  IF( NOUNIT )
-     $               TEMP = TEMP/AP( KK + J - 1 )
-                  X( J ) = TEMP
-                  KK     = KK   + J
-  100          CONTINUE
-            ELSE
-               JX = KX
-               DO 120, J = 1, N
-                  TEMP = X( JX )
-                  IX   = KX
-                  DO 110, K = KK, KK + J - 2
-                     TEMP = TEMP - AP( K )*X( IX )
-                     IX   = IX   + INCX
-  110             CONTINUE
-                  IF( NOUNIT )
-     $               TEMP = TEMP/AP( KK + J - 1 )
-                  X( JX ) = TEMP
-                  JX      = JX   + INCX
-                  KK      = KK   + J
-  120          CONTINUE
-            END IF
-         ELSE
-            KK = ( N*( N + 1 ) )/2
-            IF( INCX.EQ.1 )THEN
-               DO 140, J = N, 1, -1
-                  TEMP = X( J )
-                  K = KK
-                  DO 130, I = N, J + 1, -1
-                     TEMP = TEMP - AP( K )*X( I )
-                     K    = K    - 1
-  130             CONTINUE
-                  IF( NOUNIT )
-     $               TEMP = TEMP/AP( KK - N + J )
-                  X( J ) = TEMP
-                  KK     = KK   - ( N - J + 1 )
-  140          CONTINUE
-            ELSE
-               KX = KX + ( N - 1 )*INCX
-               JX = KX
-               DO 160, J = N, 1, -1
-                  TEMP = X( JX )
-                  IX   = KX
-                  DO 150, K = KK, KK - ( N - ( J + 1 ) ), -1
-                     TEMP = TEMP - AP( K )*X( IX )
-                     IX   = IX   - INCX
-  150             CONTINUE
-                  IF( NOUNIT )
-     $               TEMP = TEMP/AP( KK - N + J )
-                  X( JX ) = TEMP
-                  JX      = JX   - INCX
-                  KK      = KK   - (N - J + 1 )
-  160          CONTINUE
-            END IF
-         END IF
-      END IF
-*
-      RETURN
-*
-*     End of DTPSV .
-*
-      END
-      SUBROUTINE DTRSV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
-*
-************************************************************************
-*
-*     .. Scalar Arguments ..
-      INTEGER            INCX, LDA, N
-      CHARACTER*1        DIAG, TRANS, UPLO
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), X( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DTRSV  solves one of the systems of equations
-*
-*     A*x = b,   or   A'*x = b,
-*
-*  where b and x are n element vectors and A is an n by n unit, or
-*  non-unit, upper or lower triangular matrix.
-*
-*  No test for singularity or near-singularity is included in this
-*  routine. Such tests must be performed before calling this routine.
-*
-*  Parameters
-*  ==========
-*
-*  UPLO   - CHARACTER*1.
-*           On entry, UPLO specifies whether the matrix is an upper or
-*           lower triangular matrix as follows:
-*
-*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
-*
-*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
-*
-*           Unchanged on exit.
-*
-*  TRANS  - CHARACTER*1.
-*           On entry, TRANS specifies the equations to be solved as
-*           follows:
-*
-*              TRANS = 'N' or 'n'   A*x = b.
-*
-*              TRANS = 'T' or 't'   A'*x = b.
-*
-*              TRANS = 'C' or 'c'   A'*x = b.
-*
-*           Unchanged on exit.
-*
-*  DIAG   - CHARACTER*1.
-*           On entry, DIAG specifies whether or not A is unit
-*           triangular as follows:
-*
-*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
-*
-*              DIAG = 'N' or 'n'   A is not assumed to be unit
-*                                  triangular.
-*
-*           Unchanged on exit.
-*
-*  N      - INTEGER.
-*           On entry, N specifies the order of the matrix A.
-*           N must be at least zero.
-*           Unchanged on exit.
-*
-*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-*           Before entry with  UPLO = 'U' or 'u', the leading n by n
-*           upper triangular part of the array A must contain the upper
-*           triangular matrix and the strictly lower triangular part of
-*           A is not referenced.
-*           Before entry with UPLO = 'L' or 'l', the leading n by n
-*           lower triangular part of the array A must contain the lower
-*           triangular matrix and the strictly upper triangular part of
-*           A is not referenced.
-*           Note that when  DIAG = 'U' or 'u', the diagonal elements of
-*           A are not referenced either, but are assumed to be unity.
-*           Unchanged on exit.
-*
-*  LDA    - INTEGER.
-*           On entry, LDA specifies the first dimension of A as declared
-*           in the calling (sub) program. LDA must be at least
-*           max( 1, n ).
-*           Unchanged on exit.
-*
-*  X      - DOUBLE PRECISION array of dimension at least
-*           ( 1 + ( n - 1 )*abs( INCX ) ).
-*           Before entry, the incremented array X must contain the n
-*           element right-hand side vector b. On exit, X is overwritten
-*           with the solution vector x.
-*
-*  INCX   - INTEGER.
-*           On entry, INCX specifies the increment for the elements of
-*           X. INCX must not be zero.
-*           Unchanged on exit.
-*
-*
-*  Level 2 Blas routine.
-*
-*  -- Written on 22-October-1986.
-*     Jack Dongarra, Argonne National Lab.
-*     Jeremy Du Croz, Nag Central Office.
-*     Sven Hammarling, Nag Central Office.
-*     Richard Hanson, Sandia National Labs.
-*
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER        ( ZERO = 0.0D+0 )
-*     .. Local Scalars ..
-      DOUBLE PRECISION   TEMP
-      INTEGER            I, INFO, IX, J, JX, KX
-      LOGICAL            NOUNIT
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      IF     ( .NOT.LSAME( UPLO , 'U' ).AND.
-     $         .NOT.LSAME( UPLO , 'L' )      )THEN
-         INFO = 1
-      ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
-     $         .NOT.LSAME( TRANS, 'T' ).AND.
-     $         .NOT.LSAME( TRANS, 'C' )      )THEN
-         INFO = 2
-      ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
-     $         .NOT.LSAME( DIAG , 'N' )      )THEN
-         INFO = 3
-      ELSE IF( N.LT.0 )THEN
-         INFO = 4
-      ELSE IF( LDA.LT.MAX( 1, N ) )THEN
-         INFO = 6
-      ELSE IF( INCX.EQ.0 )THEN
-         INFO = 8
-      END IF
-      IF( INFO.NE.0 )THEN
-         CALL XERBLA( 'DTRSV ', INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible.
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-      NOUNIT = LSAME( DIAG, 'N' )
-*
-*     Set up the start point in X if the increment is not unity. This
-*     will be  ( N - 1 )*INCX  too small for descending loops.
-*
-      IF( INCX.LE.0 )THEN
-         KX = 1 - ( N - 1 )*INCX
-      ELSE IF( INCX.NE.1 )THEN
-         KX = 1
-      END IF
-*
-*     Start the operations. In this version the elements of A are
-*     accessed sequentially with one pass through A.
-*
-      IF( LSAME( TRANS, 'N' ) )THEN
-*
-*        Form  x := inv( A )*x.
-*
-         IF( LSAME( UPLO, 'U' ) )THEN
-            IF( INCX.EQ.1 )THEN
-               DO 20, J = N, 1, -1
-                  IF( X( J ).NE.ZERO )THEN
-                     IF( NOUNIT )
-     $                  X( J ) = X( J )/A( J, J )
-                     TEMP = X( J )
-                     DO 10, I = J - 1, 1, -1
-                        X( I ) = X( I ) - TEMP*A( I, J )
-   10                CONTINUE
-                  END IF
-   20          CONTINUE
-            ELSE
-               JX = KX + ( N - 1 )*INCX
-               DO 40, J = N, 1, -1
-                  IF( X( JX ).NE.ZERO )THEN
-                     IF( NOUNIT )
-     $                  X( JX ) = X( JX )/A( J, J )
-                     TEMP = X( JX )
-                     IX   = JX
-                     DO 30, I = J - 1, 1, -1
-                        IX      = IX      - INCX
-                        X( IX ) = X( IX ) - TEMP*A( I, J )
-   30                CONTINUE
-                  END IF
-                  JX = JX - INCX
-   40          CONTINUE
-            END IF
-         ELSE
-            IF( INCX.EQ.1 )THEN
-               DO 60, J = 1, N
-                  IF( X( J ).NE.ZERO )THEN
-                     IF( NOUNIT )
-     $                  X( J ) = X( J )/A( J, J )
-                     TEMP = X( J )
-                     DO 50, I = J + 1, N
-                        X( I ) = X( I ) - TEMP*A( I, J )
-   50                CONTINUE
-                  END IF
-   60          CONTINUE
-            ELSE
-               JX = KX
-               DO 80, J = 1, N
-                  IF( X( JX ).NE.ZERO )THEN
-                     IF( NOUNIT )
-     $                  X( JX ) = X( JX )/A( J, J )
-                     TEMP = X( JX )
-                     IX   = JX
-                     DO 70, I = J + 1, N
-                        IX      = IX      + INCX
-                        X( IX ) = X( IX ) - TEMP*A( I, J )
-   70                CONTINUE
-                  END IF
-                  JX = JX + INCX
-   80          CONTINUE
-            END IF
-         END IF
-      ELSE
-*
-*        Form  x := inv( A' )*x.
-*
-         IF( LSAME( UPLO, 'U' ) )THEN
-            IF( INCX.EQ.1 )THEN
-               DO 100, J = 1, N
-                  TEMP = X( J )
-                  DO 90, I = 1, J - 1
-                     TEMP = TEMP - A( I, J )*X( I )
-   90             CONTINUE
-                  IF( NOUNIT )
-     $               TEMP = TEMP/A( J, J )
-                  X( J ) = TEMP
-  100          CONTINUE
-            ELSE
-               JX = KX
-               DO 120, J = 1, N
-                  TEMP = X( JX )
-                  IX   = KX
-                  DO 110, I = 1, J - 1
-                     TEMP = TEMP - A( I, J )*X( IX )
-                     IX   = IX   + INCX
-  110             CONTINUE
-                  IF( NOUNIT )
-     $               TEMP = TEMP/A( J, J )
-                  X( JX ) = TEMP
-                  JX      = JX   + INCX
-  120          CONTINUE
-            END IF
-         ELSE
-            IF( INCX.EQ.1 )THEN
-               DO 140, J = N, 1, -1
-                  TEMP = X( J )
-                  DO 130, I = N, J + 1, -1
-                     TEMP = TEMP - A( I, J )*X( I )
-  130             CONTINUE
-                  IF( NOUNIT )
-     $               TEMP = TEMP/A( J, J )
-                  X( J ) = TEMP
-  140          CONTINUE
-            ELSE
-               KX = KX + ( N - 1 )*INCX
-               JX = KX
-               DO 160, J = N, 1, -1
-                  TEMP = X( JX )
-                  IX   = KX
-                  DO 150, I = N, J + 1, -1
-                     TEMP = TEMP - A( I, J )*X( IX )
-                     IX   = IX   - INCX
-  150             CONTINUE
-                  IF( NOUNIT )
-     $               TEMP = TEMP/A( J, J )
-                  X( JX ) = TEMP
-                  JX      = JX   - INCX
-  160          CONTINUE
-            END IF
-         END IF
-      END IF
-*
-      RETURN
-*
-*     End of DTRSV .
-*
-      END

In the beginning the Universe was created. This has made a lot of people very angry and has been widely regarded as a bad move.

Douglas Adams


Typeset in Trocchi and Trocchi Bold Sans Serif.