
C
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*************************
C**       LSQSIG        **
C*************************
C
C
      SUBROUTINE LSQSIG(M, N, X, CALFUN, SIGMA, FVECC, IFLAG, W)
C
      IMPLICIT NONE
C
C Purpose: Calculate approximate sigma values after a non-linear
C          least squares procedure (e.g. LSQMQL, LSQMIN, SSQMIN)
C
C          Uses a tailored version of the SLATEC library routine DCOV
C
      INTEGER M
      INTEGER N
      DOUBLE PRECISION X(*)
      DOUBLE PRECISION SIGMA(*)
      DOUBLE PRECISION FVECC(*)
      INTEGER IFLAG
      DOUBLE PRECISION W(*) 
      EXTERNAL CALFUN
C
C Parameters:
C
C INTEGER               M (I)    The number of functions f(j) occuring in the 
C                                sum of squares.
C INTEGER               N (I)    The number of variables X(1) ... X(N)
C DOUBLE PRECISION      X (I)    An array of at least length N containing
C                                the refined parameters.
C EXTERNAL         CALFUN (I)    Subroutine for calculating the function
C                                values for a given set of parameters (see
C                                below) - same as used in LSQMQL, LSQMIN,
C                                SSQMIN.
C DOUBLE PRECISION  SIGMA (O)    The estimated sigma values for the N
C                                variables (Must be dimensioned to at
C                                least N
C DOUBLE PRECISION  FVECC (O)    An array, dimensioned to at least M, returning
C                                the M values of f(j), j=1...M calculated using
C                                the refined parameter values.
C INTEGER           IFLAG (O)    Output flag = 0 OK
C                                            = 1 error in parameters
C                                            = 2 singular matrix
C DOUBLE PRECISION      W (I)    Work array dimensioned to at least
C                                (M+3)*N + M
C
C          The function minimised was
C
C                      M
C             F(x) = Sigma [f(j)(X(1),X(2),...X(N))]**2         (M>=N)
C                     j=1
C
C
C LOCALS:
C
      INTEGER I
      INTEGER IDX1, IDX2, IDX3, IDX4
      INTEGER INFO
C
C-------------------------------------------------------------------------------
C
      IFLAG = 0
      DO 10 I = 1, N
         SIGMA(I) = 0.0
 10   CONTINUE
      IDX1 = M*N + 1
      IDX2 = IDX1 + N
      IDX3 = IDX2 + N
      IDX4 = IDX3 + N
      CALL DCOV_QQQ (CALFUN, M, N, X, FVECC, W, M, INFO, W(IDX1), 
     +               W(IDX2), W(IDX3), W(IDX4))
      IF (INFO.EQ.0) IFLAG = 1
      IF (INFO.EQ.2) IFLAG = 2
      IF (IFLAG.EQ.0) THEN
         DO 20 I = 1, N
            SIGMA(I) = SQRT (W((I-1)*M+I))
 20      CONTINUE
      END IF
      RETURN
      END
