C @(#)mono4.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 MONO4(IVX,VZ,NP,VP,FS)
C+++++
C.PURPOSE: Fit con gaussiana monodimensionale a 4 parametri:
C          altezza; larghezza; posizione; fondo)
C-----
      IMPLICIT NONE
      INTEGER  IVX(1)
      REAL     VZ(1)
      INTEGER  NP
      REAL     VP(4)
      REAL     FS
C
      INTEGER  I,J, K
      REAL     EPES, EP, CO, FNO
      REAL     FK
      INTEGER  NCD
      REAL     VPR(4)
      REAL     RMT(4,4)
      REAL     VTN(4)
      REAL     VFZ(4)
      REAL     VFF(4)
      REAL     VC(4)
      REAL     SG(4)
C
      DATA    VPR/2.,1.,1.,2./
C
C *** start the code
      DO 10 I = 1,4
         VFF(I) = 0
         VFZ(I) = 0
         VC(I)  = 0
         DO 20 J = 1,4
            RMT(I,J) = 0
   20    CONTINUE
   10 CONTINUE

      FK     = -4.*ALOG(2.)/(VP(3)**2)
      VTN(4) = 1

      DO 30 K = 1,NP
         EPES   = (IVX(K)-VP(2))**2
         EP     = EXP(EPES*FK)
         CO     = -VP(1)*EP*2.*FK
         VTN(1) = EP
         VTN(2) = CO*(IVX(K)-VP(2))
         VTN(3) = CO*(IVX(K)-VP(2))**2/VP(3)
         FNO    = VP(1)*EP+VP(4)
C
         DO 40 I = 1,4
            VFZ(I) = VFZ(I)+VZ(K)*VTN(I)
            VFF(I) = VFF(I)+FNO*VTN(I)
            DO 50 J = 1,4
               RMT(I,J)=RMT(I,J)+VTN(I)*VTN(J)
   50       CONTINUE
   40    CONTINUE
   30 CONTINUE
C
      DO 60 I = 1,4
         RMT(I,I) = RMT(I,I)*(1+FS**2)
         VC(I)    = VC(I)+VFZ(I)-VFF(I)
   60 CONTINUE
C
      NCD = 4
      CALL LISIB(RMT,VC,4,NCD,SG)
      DO 70  I = 1,4
        VP(I)= VC(I)*VPR(I)+VP(I)
   70 CONTINUE

      RETURN
      END