C @(#)lisid.for 17.1.1.1 (ES0-DMD) 01/25/02 17:17:57 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 LISID(RMT,VN,NEQ,ND) C++++ C.Purpose: RMT = MATRICE COEFFICIENTI C VN = VETTORE TERMINI NOTI IN INPUT C VETTORE SOLUZIONE IN OUTPUT C NEQ = NUMERO EQUAZIONI SISTEMA C ND = DIMENSIONI DELLA MATRICE RMT C IMPLICIT DOUBLE PRECISION(A-H,O-Z) DOUBLE PRECISION RMT(ND,ND) DOUBLE PRECISION VN(1) INTEGER NEQ INTEGER ND C INTEGER I, J, K, L C IF (NEQ.LE.ND) THEN DO 10 I = 1,NEQ ! controllo coefficienti IF (ND.GT.0) THEN L = 0 IF (RMT(I,I).EQ.0) THEN L = 10 DO 20 J = 1,NEQ IF (RMT(J,I).NE.0 .AND. RMT(I,J).NE.0 .AND. 2 L.EQ.10) THEN DO 30 K = 1,NEQ AP = RMT(I,K) RMT(I,K) = RMT(J,K) RMT(J,K) = AP 30 CONTINUE AP = VN(I) VN(I) = VN(J) VN(J) = AP L = 100 END IF 20 CONTINUE END IF C IF (L.EQ.10) THEN ND = -1 END IF END IF 10 CONTINUE C IF (ND.GT.0) THEN DO 40 I = 1,NEQ ! soluzione sistema A = RMT(I,I) DO 50 L=I,NEQ RMT(I,L)=RMT(I,L)/A 50 CONTINUE VN(I) = VN(I)/A DO 60 J = 1,NEQ IF (J.NE.I) THEN B = RMT(J,I) DO 70 K=I,NEQ RMT(J,K) = RMT(J,K)-RMT(I,K)*B 70 CONTINUE VN(J) = VN(J)-VN(I)*B END IF 60 CONTINUE 40 CONTINUE END IF END IF C RETURN END