C @(#)cloudemi.for	17.1.1.1 (ESO-DMD) 01/25/02 17:13:49
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
       PROGRAM EMI
C**************************************************
C       M.PIERRE 10-87                             
C                                                   
C       CALCULATION OF  A EMISSION SPECTRUM        
C                 SUM OF GAUSSIANS     (MAX 50 )       
C                       +                          
C                 POLYNIMIAL CONTINUUM (MAX DEG=5)   
C       Modified - START, STEP double precision in i/o
C 
C 990805
C**************************************************
C
       IMPLICIT NONE
C
       CHARACTER*60 IMA,TBL
       CHARACTER*72 IDENT
       CHARACTER*64 CUNIT
       LOGICAL      NULL1,NULL2,NULL3,ISEL
       INTEGER      MADRID(1),TID, I1, NCARA, KUN, KNUL
       INTEGER      IST, NPIX, NGAUSS, I, NAC, NAR, IMNO
       INTEGER*8    PNTR
C 
       REAL         DIM(3),CONT(6)
       REAL         HMAX(50),POS(50),FWHM(50)
       REAL         X1, X2, X3, START, STEP
C 
       DOUBLE PRECISION DSTA, DSTP
C
       COMMON/VMR/MADRID
C
       CALL STSPRO('EMI')
C
       CALL STKRDC('IN_A',1,1,60,NCARA,IMA,KUN,KNUL,IST)
       CALL STKRDC('IN_B',1,1,60,NCARA,TBL,KUN,KNUL,IST)
       CALL STKRDR('CLDCT',1,6,NCARA,CONT,KUN,KNUL,IST)
       CALL STKRDR('CLDDIM',1,3,NCARA,DIM,KUN,KNUL,IST)
C
       START=DIM(1)
       STEP =DIM(2)
       NPIX =INT(DIM(3))
C
       I1 = 0
        IF (TBL(1:4).EQ.'NULL') THEN
           NGAUSS = 0
        ELSE
          CALL TBTOPN(TBL,0,TID,IST)
          CALL TBIGET(TID,I,NGAUSS,I,NAC,NAR,IST)
          DO 10 I=1,NGAUSS
            CALL TBSGET(TID,I,ISEL,IST)
            IF (ISEL) THEN
              CALL TBERDR(TID,I,2,X1,NULL1,IST)
              CALL TBERDR(TID,I,3,X2,NULL2,IST)
              CALL TBERDR(TID,I,4,X3,NULL3,IST)
              IF (NULL1 .OR. NULL2 .OR. NULL3) GOTO 5
                 I1        = I1 + 1
                 HMAX(I1)  = X1
                 POS(I1)   = X2
                 FWHM(I1)  = X3
5             CONTINUE
            ENDIF
10        CONTINUE
          NGAUSS = I1
        ENDIF
C
       IDENT='EMI. SPEC.'//TBL
       CUNIT= ' '
       DSTA = START
       DSTP = STEP
       CALL STIPUT(IMA,10,1,1,1,NPIX,DSTA,DSTP,IDENT,
     :                   CUNIT,PNTR,IMNO,IST)       
       CALL IMAGE(MADRID(PNTR),NPIX,STEP,START,NGAUSS,
     :             HMAX,POS,FWHM,CONT)
       CALL STSEPI
       STOP
       END
C
C ********* SOUS PROGRAMME ******************
C
       SUBROUTINE IMAGE(Y,NPIX,STEP,START,NGAUSS,
     :                    HMAX,POS,FWHM,CONT)
       INTEGER NPIX,I,NGAUSS,J
       REAL START,STEP,RAIE,WL,WWLL
       REAL Y(1),HMAX(1),POS(1),FWHM(1),CONT(1)
C
       DO 30 I=1,NPIX
          WL=START+FLOAT(I-1)*STEP
          Y(I)=CONT(1)
          WWLL=WL
          DO 10 J=2,6
             Y(I)=+Y(I)+CONT(J)*WWLL 
             WWLL=WWLL*WL
10        CONTINUE
          IF (NGAUSS.GT.0) THEN
             DO 20 J=1,NGAUSS
                RAIE=HMAX(J)*EXP(-0.69315*((2.*(POS(J)-WL)
     :               /FWHM(J))**2))
                Y(I)=RAIE+Y(I)
20           CONTINUE
          ENDIF
30     CONTINUE
C
       RETURN
       END
C