C @(#)rar.for 17.1.1.1 (ESO-DMD) 01/25/02 17:13:34 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