MINICERN/mathlib/gen/e/rlsqp2.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:24  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE RLSQP2(N,X,Y,A0,A1,A2,SD,IFAIL)
  11       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
  12       REAL X,Y,A0,A1,A2,SD
  13
  14       DIMENSION X(*),Y(*)
  15
  16       PARAMETER (R0 = 0)
  17
  18       A0=0
  19       A1=0
  20       A2=0
  21       SD=0
  22       IF(N .LE. 2) THEN
  23        IFAIL=1
  24       ELSE
  25        FN=N
  26        XM=0
  27        DO 1 K = 1,N
  28        XM=XM+X(K)
  29     1  CONTINUE
  30        XM=XM/FN
  31        SX=0
  32        SXX=0
  33        SXXX=0
  34        SXXXX=0
  35        SY=0
  36        SYY=0
  37        SXY=0
  38        SXXY=0
  39        DO 2 K = 1,N
  40        XK=X(K)-XM
  41        YK=Y(K)
  42        XK2=XK**2
  43        SX=SX+XK
  44        SXX=SXX+XK2
  45        SXXX=SXXX+XK2*XK
  46        SXXXX=SXXXX+XK2**2
  47        SY=SY+YK
  48        SYY=SYY+YK**2
  49        SXY=SXY+XK*YK
  50        SXXY=SXXY+XK2*YK
  51     2  CONTINUE
  52        DET=(FN*SXXXX-SXX**2)*SXX-FN*SXXX**2
  53        IF(DET .GT. 0) THEN
  54         D2=(SXX*(FN*SXXY-SXX*SY)-FN*SXXX*SXY)/DET
  55         D1=(SXY-SXXX*D2)/SXX
  56         D0=(SY-SXX*D2)/FN
  57         IFAIL=0
  58        ELSE
  59         IFAIL=-1
  60        ENDIF
  61       ENDIF
  62       IF(IFAIL .EQ. 0 .AND. N .GT. 3)
  63      1   SD=SQRT(MAX(R0,SYY-D0*SY-D1*SXY-D2*SXXY)/(N-3))
  64       A0=D0+XM*(XM*D2-D1)
  65       A1=D1-2*XM*D2
  66       A2=D2
  67       RETURN
  68       END