*DECK ALPLSF
      SUBROUTINE ALPLSF(IMETH,N,X,Y,EPSRID,LREAL,NOR,A,B,PREC)
*
*-----------------------------------------------------------------------
*
* COMPUTE THE POLYNOMIAL COEFFICIENTS OF A PADE APPROXIMATION USING A
* DIRECT LEAST SQUARE PROCEDURE.
*
* INPUT PARAMETERS:
*  IMETH  : TYPE OF ALGORITHM (=1: USE QR; =2: USE SVD; =3: USE NNLS).
*  N      : NUMBER OF COLLOCATION POINTS.
*  X      : ABSCISSA OF THE COLLOCATION POINTS. REAL X(N)
*  Y      : ORDINATES OF THE COLLOCATION POINTS. REAL Y(N)
*  EPSRID : EPSILON USED IN POLYNOMIAL SIMPLIFICATION.
*  LREAL  : =.TRUE. TO GET RID OF COMPLEX ROOTS.
*
* OUTPUT PARAMETERS:
*  NOR    : ORDER OF THE POLYNOMIALS.
*  A      : POLYNOMIAL COEFFICIENTS OF THE NUMERATOR OF THE PADE
*           APPROXIMATION. A(0) IS THE CONSTANT TERM.
*  B      : POLYNOMIAL COEFFICIENTS OF THE DENOMINATOR OF THE PADE
*           APPROXIMATION. B(0) IS THE CONSTANT TERM.
*           DOUBLE PRECISION A(0:NOR),B(0:NOR)
*  PREC   : ACCURACY OF THE FIT.
*
*------------------------------------- AUTHOR: A. HEBERT ; 10/01/96 ----
*
      PARAMETER (MAXNOR=10,MAXPTS=99)
      INTEGER IMETH,N,NOR
      REAL X(N),Y(N),PREC
      DOUBLE PRECISION A(0:(N-1)/2),B(0:(N-1)/2),AA(MAXPTS,MAXPTS),
     1 BB(MAXPTS),GAR,PARAM(MAXPTS),AGAR(0:MAXNOR),BGAR(0:MAXNOR),
     2 CGAR(0:MAXNOR+1),EPSRID,V(MAXPTS,MAXPTS),W(MAXPTS),RV1(MAXPTS),
     3 SGN,GAROLD,YAPPR,RNORM,RMAX
      COMPLEX*16 SIGX0(MAXNOR+1),SIGXW(MAXNOR+1),DDAGAR(0:MAXNOR),
     1 DDBGAR(0:MAXNOR),WEIGH(MAXNOR+1),CC,DD,CCC,XCC,DCC
      LOGICAL LREAL,LFAIL
*
      IF(N.GT.MAXPTS) CALL XABORT('ALPLSF: INSUFFICIENT MAXPTS.')
*
* NOR=0 CASE.
      GAROLD=0.0
      NOR=0
      PREC=0.0
      A(0)=DBLE(Y(N))
      B(0)=1.0D0
      DO 10 I=1,N-1
   10 PREC=MAX(PREC,ABS(Y(N)/Y(I)-1.0))
*
      RMAX=1.0D10
      DO 210 IINOR=1,MIN((N-1)/2,MAXNOR)
      INOR=IINOR
      IF(X(N).GE.0.99E10) THEN
         DO 40 I=1,N-1
         GAR=1.0D0
         IOF=0
         DO 20 J=0,INOR-1
         IOF=IOF+1
         AA(I,IOF)=GAR
   20    GAR=GAR*X(I)
         GAR=1.0D0
         DO 30 J=0,INOR-1
         IOF=IOF+1
         GAROLD=GAR
         AA(I,IOF)=-GAR*Y(I)
   30    GAR=GAR*X(I)
         BB(I)=(Y(I)-Y(N))*X(I)
         DO 40 J=1,2*INOR
   40    AA(I,J)=AA(I,J)/GAROLD
         IF(IMETH.EQ.1) THEN
            CALL ALST2F(MAXPTS,N-1,2*INOR,AA,RV1)
            CALL ALST2S(MAXPTS,N-1,2*INOR,AA,RV1,BB,PARAM)
         ELSE IF(IMETH.EQ.2) THEN
            CALL ALSVDF(AA,N-1,2*INOR,MAXPTS,MAXPTS,W,V,RV1)
            DO 45 J=1,2*INOR
            IF(W(J).EQ.0.0D0) CALL XABORT('ALPLSF: SVD FAILURE(1).')
   45       CONTINUE
            CALL ALSVDS(AA,W,V,N-1,2*INOR,MAXPTS,MAXPTS,BB,PARAM,RV1)
         ELSE IF(IMETH.EQ.3) THEN
            CALL ALNNLS(AA,N-1,2*INOR,MAXPTS,MAXPTS,BB,PARAM,RNORM,MODE)
            IF(MODE.NE.1) CALL XABORT('ALPLSF: NNLS FAILURE(1).')
            IF((INOR.GT.1).AND.(RNORM.GE.0.95D0*RMAX)) GO TO 210
            RMAX=RNORM
         ENDIF
         DO 50 I=0,INOR-1
         AGAR(I)=PARAM(I+1)
   50    BGAR(I)=PARAM(INOR+1+I)
         AGAR(INOR)=Y(N)
         BGAR(INOR)=1.0D0
      ELSE
         DO 80 I=1,N
         GAR=1.0D0
         IOF=0
         DO 60 J=0,INOR
         IOF=IOF+1
         AA(I,IOF)=GAR
   60    GAR=GAR*X(I)
         GAR=1.0D0
         DO 70 J=0,INOR-1
         IOF=IOF+1
         GAROLD=GAR
         AA(I,IOF)=-GAR*Y(I)
   70    GAR=GAR*X(I)
         BB(I)=Y(I)*X(I)
         DO 80 J=1,2*INOR+1
   80    AA(I,J)=AA(I,J)/GAROLD
         IF(IMETH.EQ.1) THEN
            CALL ALST2F(MAXPTS,N,2*INOR+1,AA,RV1)
            CALL ALST2S(MAXPTS,N,2*INOR+1,AA,RV1,BB,PARAM)
         ELSE IF(IMETH.EQ.2) THEN
            CALL ALSVDF(AA,N,2*INOR+1,MAXPTS,MAXPTS,W,V,RV1)
            DO 85 J=1,2*INOR
            IF(W(J).EQ.0.0D0) CALL XABORT('ALPLSF: SVD FAILURE(2).')
   85       CONTINUE
            CALL ALSVDS(AA,W,V,N,2*INOR+1,MAXPTS,MAXPTS,BB,PARAM,RV1)
         ELSE IF(IMETH.EQ.3) THEN
            CALL ALNNLS(AA,N,2*INOR+1,MAXPTS,MAXPTS,BB,PARAM,RNORM,MODE)
            IF(MODE.NE.1) CALL XABORT('ALPLSF: NNLS FAILURE(2).')
            IF((INOR.GT.1).AND.(RNORM.GE.0.95D0*RMAX)) GO TO 210
            RMAX=RNORM
         ENDIF
         DO 90 I=0,INOR
         AGAR(I)=PARAM(I+1)
         IF(I.EQ.INOR) THEN
            BGAR(I)=1.0D0
         ELSE
            BGAR(I)=PARAM(INOR+2+I)
         ENDIF
   90    CONTINUE
      ENDIF
*
* POLYNOMIAL SIMPLIFICATION.
      DDAGAR(0)=AGAR(INOR)
      DDBGAR(0)=BGAR(INOR)
      CALL ALROOT(AGAR,INOR,SIGX0,LFAIL)
      IF(LFAIL) GO TO 210
      CALL ALROOT(BGAR,INOR,SIGXW,LFAIL)
      IF(LFAIL) GO TO 210
      IJINOR=1
   95 XXX=REAL(ABS(DBLE(SIGXW(IJINOR))-DBLE(SIGX0(IJINOR))))
      IF(XXX.LT.EPSRID*ABS(DBLE(SIGXW(IJINOR)))) THEN
         INOR=INOR-1
         DO 100 I=IJINOR,INOR
         SIGX0(I)=SIGX0(I+1)
  100    SIGXW(I)=SIGXW(I+1)
      ELSE IF((DBLE(SIGXW(IJINOR)).GT.EPSRID).AND.
     >        (DIMAG(SIGXW(IJINOR)).EQ.0.0).AND.
     >        (IMETH.EQ.3)) THEN
         CALL XABORT('ALPLSF: NNLS FAILURE(3).')
      ELSE IF((DBLE(SIGXW(IJINOR)).GT.0.1*EPSRID).AND.
     >        (DIMAG(SIGXW(IJINOR)).EQ.0.0)) THEN
         GO TO 210
      ELSE
         IJINOR=IJINOR+1
      ENDIF
      IF(IJINOR.LE.INOR) GO TO 95
      IF(INOR.LT.0) CALL XABORT('ALPLSF: ALGORITHM FAILURE.')
      DO 120 I=1,INOR
      DDAGAR(I)=DDAGAR(I-1)
      DDBGAR(I)=DDBGAR(I-1)
      DO 110 J=I-1,1,-1
      DDAGAR(J)=DDAGAR(J-1)-DDAGAR(J)*SIGX0(I)
  110 DDBGAR(J)=DDBGAR(J-1)-DDBGAR(J)*SIGXW(I)
      DDAGAR(0)=-DDAGAR(0)*SIGX0(I)
  120 DDBGAR(0)=-DDBGAR(0)*SIGXW(I)
      DO 130 I=0,INOR
      AGAR(I)=DBLE(DDAGAR(I))/DBLE(DDBGAR(INOR))
      BGAR(I)=DBLE(DDBGAR(I))/DBLE(DDBGAR(INOR))
      IF(AGAR(I).LE.0.0D0) GO TO 210
      IF(BGAR(I).LE.0.0D0) GO TO 210
  130 CONTINUE
      SGN=1.0D0
      CGAR(0)=AGAR(0)
      DO 135 I=2,INOR+1
      SGN=-SGN
  135 CGAR(I-1)=SGN*(BGAR(I-2)+AGAR(I-1))
      CGAR(INOR+1)=-SGN
      CALL ALROOT(CGAR,INOR+1,SIGX0,LFAIL)
      IF(LFAIL) GO TO 210
*
* NEWTON IMPROVEMENT OF THE ROOTS.
      DO 138 I=1,INOR+1
      CCC=0.0D0
      XCC=1.0D0
      DO 136 J=0,INOR+1
      CCC=CCC+CGAR(J)*XCC
  136 XCC=XCC*SIGX0(I)
      DCC=0.0D0
      XCC=1.0D0
      DO 137 J=1,INOR+1
      DCC=DCC+CGAR(J)*XCC*REAL(J)
  137 XCC=XCC*SIGX0(I)
  138 SIGX0(I)=SIGX0(I)-CCC/DCC
*
      IF(LREAL) THEN
         DO 140 I=1,INOR+1
         IF(DBLE(SIGX0(I)).LT.1.0E-10) GO TO 210
         IF(DIMAG(SIGX0(I)).NE.0.0) GO TO 210
  140    CONTINUE
      ENDIF
*
* COMPUTE THE WEIGHTS.
      DO 170 I=1,INOR+1
      CC=(1.0D0,0.0D0)
      DD=0.0D0
      DO 150 JNOR=0,INOR
      DD=DD+BGAR(JNOR)*CC
  150 CC=-CC*SIGX0(I)
      DO 160 J=1,INOR+1
      IF(J.NE.I) DD=DD/(SIGX0(J)-SIGX0(I))
  160 CONTINUE
  170 WEIGH(I)=DD
*
* TEST THE ACCURACY OF THE PADE APPROXIMATION.
      PREC1=0.0
      DO 190 I=1,N
      CC=0.0D0
      DD=0.0D0
      DO 180 JNOR=1,INOR+1
      CC=CC+WEIGH(JNOR)/(SIGX0(JNOR)+X(I))
  180 DD=DD+WEIGH(JNOR)*SIGX0(JNOR)/(SIGX0(JNOR)+X(I))
      YAPPR=DBLE(DD/CC)
  190 PREC1=MAX(PREC1,ABS(REAL(YAPPR)/Y(I)-1.0))
*
      IF(PREC1.LT.0.95*PREC) THEN
         NOR=INOR
         PREC=PREC1
         DO 200 I=0,NOR
         A(I)=AGAR(I)
  200    B(I)=BGAR(I)
      ENDIF
  210 CONTINUE
      RETURN
      END
