C @(#)iperd.for	17.1.1.1 (ES0-DMD) 01/25/02 17:17:56
C===========================================================================
C Copyright (C) 1995 European Southern Observatory (ESO)
C
C This program is free software; you can redistribute it and/or 
C modify it under the terms of the GNU General Public License as 
C published by the Free Software Foundation; either version 2 of 
C the License, or (at your option) any later version.
C
C This program is distributed in the hope that it will be useful,
C but WITHOUT ANY WARRANTY; without even the implied warranty of
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C GNU General Public License for more details.
C
C You should have received a copy of the GNU General Public 
C License along with this program; if not, write to the Free 
C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
C MA 02139, USA.
C
C Corresponding concerning ESO-MIDAS should be addressed as follows:
C	Internet e-mail: midas@eso.org
C	Postal address: European Southern Observatory
C			Data Management Division 
C			Karl-Schwarzschild-Strasse 2
C			D 85748 Garching bei Muenchen 
C			GERMANY
C===========================================================================
C
      SUBROUTINE IPERD (X,Y,Z,C,N,I,SQM,IN)
C+++     
C.Purpose: npa: numero parametri pari a (i**2)+3*i+2)/2
C---     
      IMPLICIT         NONE
      INTEGER          NPA
      PARAMETER        (NPA=35)
      DOUBLE PRECISION X(1)
      DOUBLE PRECISION Y(1)
      DOUBLE PRECISION Z(1)
      DOUBLE PRECISION C(1)
      INTEGER          N
      INTEGER          I
      REAL             SQM
      INTEGER          IN
C
      INTEGER          NB
      INTEGER          K, J, L, LL
      INTEGER          IL, NE
      INTEGER          ISTAT
      REAL             VZ
      DOUBLE PRECISION VD(NPA,NPA),V(NPA)
      DOUBLE PRECISION VF,AA,BB
      CHARACTER        STRING*80
C
  901 FORMAT('       SQM = ',E12.5)
C
C *** initialize parameters
      SQM = 0.
      NB  = 1
      DO 10 K=1,NPA
         C(K)=0.
         DO 11 J=1,NPA
            VD(K,J)=0.
  11     CONTINUE
  10  CONTINUE
C
C *** fit the data
      DO 20 L = 1,N
         IN = 0
         DO 30 K = 0,I,1
            DO 40 J = 0,I-K,1
               IN    = IN+1
               V(IN) = (X(L)**J)*(Y(L)**K)
               IF (IN.GT.1) THEN
                  VD(1,IN) = VD(1,IN)+V(IN)
                  VD(IN,1) = VD(1,IN)
                  C(IN)    = C(IN)+Z(L)*V(IN)
                  DO 50 LL = 2,IN
                     VF        = V(IN)*V(LL)
                     VD(LL,IN) = VD(LL,IN)+VF
                     IF (IN.NE.LL) THEN
                        VD(IN,LL)=VD(LL,IN)
                     ENDIF
   50             CONTINUE
               ELSE
                  VD(1,1) = VD(1,1)+V(1)
                  C(1)    = C(1)+Z(L)
               END IF
   40       CONTINUE
   30    CONTINUE
   20 CONTINUE
C
      NE=IN
      CALL LISID(VD,C,NE,NPA)
      DO 60 J=1,N
         IL=0
         VZ=0.
         DO 70 L=0,I
            DO 80 K=0,I-L
               IL = IL+1
               IF (K.EQ.0.AND.X(J).EQ.0.) THEN
                 AA = 1.
               ELSE 
                 AA = X(J)**K
               END IF
C
               IF (L.EQ.0.AND.Y(J).EQ.0.) THEN
                  BB = 1.
               ELSE
                  BB = Y(J)**L
               END IF
               VZ = VZ+AA*BB*C(IL)
   80       CONTINUE
   70    CONTINUE
         SQM = SQM+(Z(J)-VZ)**2
   60 CONTINUE
C
      SQM = SQRT(SQM/FLOAT(N))
      WRITE(STRING,901) SQM
      CALL STTPUT(STRING,ISTAT)
      RETURN
      END