C @(#)lsqgrd.for 17.1.1.1 (ES0-DMD) 01/25/02 17:10:50 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 LSQGRD(NRPNT,NRPRM,FCTVEC,FCTJAC,LJAC,GRD) C IMPLICIT NONE C .. Scalar Arguments .. INTEGER LJAC,NRPRM,NRPNT C .. C .. Array Arguments .. DOUBLE PRECISION FCTJAC(LJAC,NRPRM),FCTVEC(NRPNT),GRD(NRPRM) C .. C .. Local Scalars .. DOUBLE PRECISION S INTEGER I,J C .. C .. External Files .. INCLUDE 'MID_INCLUDE:FITNAGI.INC/NOLIST' INCLUDE 'MID_INCLUDE:FITNAGC.INC/NOLIST' C .. C .. Executable Statements .. DO 20 I = 1,NRPRM S = 0.D0 IF (FIXPAR(I).LT.0) THEN DO 10 J = 1,NRPNT S = S + FCTJAC(J,I)*FCTVEC(J) 10 CONTINUE END IF GRD(I) = S + S 20 CONTINUE RETURN END