C @(#)syst.for 17.1.1.1 (ES0-DMD) 01/25/02 17:19:02 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 SYST(N,A,C,JER) C +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C.PURPOSE: System solution for polynomial of degree ideg=(sqrt(8*n+1)-2)/2 C ---------------------------------------------------------------------- IMPLICIT NONE INTEGER N DOUBLE PRECISION A(21,22) DOUBLE PRECISION C(21) INTEGER JER C DOUBLE PRECISION B,P INTEGER I, I1 INTEGER K INTEGER L INTEGER J, J1 INTEGER N1, N2 N1 = N - 1 N2 = N + 1 DO 60 I = 1,N1 B = DABS(A(I,I)) I1 = I + 1 K = I DO 10 J = I1,N IF (B.GT.DABS(A(J,I))) GO TO 10 B = DABS(A(J,I)) K = J 10 CONTINUE IF (B.EQ.0.0D0) GO TO 90 IF (K.EQ.I) GO TO 30 DO 20 J = I,N2 P = A(K,J) A(K,J) = A(I,J) A(I,J) = P 20 CONTINUE 30 DO 50 J = I,N1 J1 = J + 1 P = A(J1,I)/A(I,I) DO 40 L = I1,N2 A(J1,L) = A(J1,L) - P*A(I,L) 40 CONTINUE 50 CONTINUE 60 CONTINUE IF (A(N,N).EQ.0.0D0) GO TO 90 C(N) = A(N,N2)/A(N,N) DO 80 I = 1,N1 J = N - I P = A(J,N2) DO 70 L = 1,I K = N2 - L P = P - C(K)*A(J,K) 70 CONTINUE C(J) = P/A(J,J) 80 CONTINUE JER = 0 ! no error RETURN 90 CONTINUE JER = 1 ! error return RETURN END