C @(#)rar.for	19.1 (ESO-DMD) 02/25/03 13:23:05
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 Massachusetts Ave, Cambridge, 
C MA 02139, USA.
C
C Correspondence 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
C----------------------------------------------------------------------
      SUBROUTINE RAR(I,K,N,KK,IXY,IDX,IDY,X,AR)
C----------------------------------------------------------------------
      IMPLICIT REAL*8 (A-H,O-Z), INTEGER*4 (I-N)
C 
      PARAMETER   (MAXOBJ=100001)
C 
      DIMENSION X(10),X1(10),AR(MAXOBJ,4),KK(9),IDX(9),IDY(9)
C 
      DO0 = 0.0D0
      DO1 = 1.0D0
C 
      IF (K.EQ.0) THEN
C     *this one is used by pos1-2
          X1(1) = AR(I,1) 
          X1(2) = AR(I,2) 
          X1(3) = AR(I,1)*AR(I,2) 
          X1(4) = AR(I,1)**2
          X1(5) = AR(I,2)**2
          X1(6) = AR(I,1)**3
          X1(7) = AR(I,2)**3
          X1(8) = AR(I,1)*AR(I,2)**2
          X1(9) = AR(I,2)*AR(I,1)**2
          ENDIF

      IF (K.EQ.1) THEN
          X1(1) = DO1 
          X1(2) = DO0 
          X1(3) = AR(I,2) 
          X1(4) = 2.0D0*AR(I,1) 
          X1(5) = DO0 
          X1(6) = 3.0D0*AR(I,1)**2
          X1(7) = DO0 
          X1(8) = AR(I,2)**2
          X1(9) = 2.0D0*AR(I,2)*AR(I,1) 
          ENDIF

      IF (K.EQ.2) THEN
          X1(1) = DO0 
          X1(2) = DO1 
          X1(3) = AR(I,1) 
          X1(4) = DO0 
          X1(5) = 2.0D0*AR(I,2) 
          X1(6) = DO0 
          X1(7) = 3.0D0*AR(I,2)**2
          X1(8) = 2.0D0*AR(I,1)*AR(I,2) 
          X1(9) = AR(I,1)**2
          ENDIF

    5 IF(IXY.EQ.1) X1(10) = AR(I,3) 
      IF(IXY.EQ.2) X1(10) = AR(I,4) 

      DO 6 L = 1,9
    6   KK(L) = 0 

      IF (IXY .NE. 2) THEN
C     *IX=1
         I1 = 0 

         DO 10 J=1,9 
            IF (IDX(J).NE.0) THEN
               I1 = I1+1 
               X(I1) = X1(J) 
               KK(I1) = J
            ENDIF
 10      CONTINUE
         
        
         IF (N-I1.NE.1) THEN
            WRITE(6,9060) N,I1
 9060       FORMAT(1X,'COEFF TROUBLE',2I6)
            STOP
         ENDIF
         
         X(I1+1) = X1(10)
         RETURN
      ELSE
C     *ixy=2
 20      I1= 0 
         DO 30 J=1,9 
            IF (IDY(J).EQ.0) GOTO 30 
            I1 = I1+1 
            X(I1) = X1(J) 
            KK(I1) = J
 30      CONTINUE
      
         IF ( N-I1 .EQ. 1) THEN
            X(I1+1) = X1(10)
            RETURN
         ENDIF
      ENDIF
      RETURN
C 
      END 


