C @(#)necripcor.for	17.1.1.1 (ESO-DMD) 01/25/02 17:51:31
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
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C 
C.COPYRIGHT: Copyright (c) 1991 European Southern Observatory,
C                                         all rights reserved
C
C.VERSION: 1.0          23-JULY-1991
C
C.LANGUAGE: F77+ESOext
C
C.AUTHOR: P.BALLESTER
C
C.IDENTIFICATION
C
C.KEYWORDS
C
C  ECHELLE, CASPEC, BLAZE FUNCTION
C
C.PURPOSE
C
C  compute the ECHELLE constants to set successive orders at the same level
C
C.ALGORITHM
C
C  IN DEVELOPMENT ...
C
C.VERSION
C 
C 010706		last modif
C C 
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

      PROGRAM RIPPLE

      IMPLICIT  NONE

      INTEGER   NAXISA,NPIXA(2),IAV,STAT,ACTVAL,MAXORD
      INTEGER   IMNOA
      INTEGER   KNULL,KUNIT(1),BOUND(3)
      INTEGER   MADRID(1)
C 
      INTEGER*8   PNTRA
C
      PARAMETER (MAXORD=500)
C
      CHARACTER FRAMEA*60
      CHARACTER CUNIT*64,IDENTA*72
C
      INTEGER          NPTOT(MAXORD)
      INTEGER          ORDSTA(MAXORD),ORDEND(MAXORD)
C 
      REAL             CONST(MAXORD)
C 
      DOUBLE PRECISION STEPA(2),STARTA(2),WSTART(MAXORD)
C 
      INCLUDE 'MID_INCLUDE:st_def.inc'
      COMMON /VMR/ MADRID
      INCLUDE 'MID_INCLUDE:st_dat.inc'
C
      CALL STSPRO('RIPPLE')
      CALL STKRDC('IN_A',1,1,60,IAV,FRAMEA,KUNIT,KNULL,STAT)

      CALL STIGET(FRAMEA,D_R4_FORMAT,F_IO_MODE,F_IMA_TYPE,
     +            2,NAXISA,NPIXA,STARTA,STEPA,IDENTA,CUNIT,
     +            PNTRA,IMNOA,STAT)

      IF (NPIXA(2).LT.MAXORD) THEN
          CALL STDRDD(IMNOA,'WSTART',1,NPIXA(2),ACTVAL,WSTART,
     +                                       KUNIT,KNULL,STAT)
          CALL STDRDI(IMNOA,'NPTOT',1,NPIXA(2),ACTVAL,NPTOT,
     +                                       KUNIT,KNULL,STAT)
          CALL STDRDI(IMNOA,'ORDSTA',1,NPIXA(2),ACTVAL,ORDSTA,
     +                                       KUNIT,KNULL,STAT)
          CALL STDRDI(IMNOA,'ORDEND',1,NPIXA(2),ACTVAL,ORDEND,
     +                                       KUNIT,KNULL,STAT)
      ELSE
          CALL STETER(10,'Buffer overflow in RIPPLE.')
      ENDIF

      CALL STKRDI('INPUTI',1,3,IAV,BOUND,KUNIT,KNULL,STAT)

      CALL NORM(MADRID(PNTRA),NPIXA(1),NPIXA(2),STARTA(1),STEPA(1),
     +            WSTART,BOUND,CONST,ORDSTA,ORDEND)

      CALL STSEPI

      END

C ======================Normalization Routine====================

      SUBROUTINE NORM(INPFRAM,NX,NY,START,STEP,
     +                WST,BOUND,CONST,ORDSTA,ORDEND)

      IMPLICIT   NONE

      INTEGER    NX,NY,BOUND(3),ROW,COL
      INTEGER    PIXSTA,PIXEND,NPIX,MIDORD
      INTEGER    ORDSTA(NY),ORDEND(NY)

      REAL       INPFRAM(NX,NY)

      REAL       SN,SN1,CONST(NY),FACTOR

      DOUBLE PRECISION  WST(NY),START,STEP,LAMBST,LAMBED


C --- LOOP ON ORDERS

      DO 10 ROW = 1,(NY-1)


C ---    Determine lambda start, lambda end and pixel width in overlap.

         PIXSTA = ORDSTA(ROW+1) + BOUND(1) + 1
         LAMBST = WST(ROW+1)+(PIXSTA-1)*STEP      !  Lambda Start

         PIXEND = ORDEND(ROW) - BOUND(2)
         LAMBED = WST(ROW)+(PIXEND-1)*STEP        !  Lambda End

         NPIX   = (LAMBED-LAMBST)/STEP ! Assume linear step in wavelength
C         TYPE*,'Order, nb pix., delta wav.',ROW,NPIX,LAMBST,LAMBED

C ---    Estimate normalization constant.

         SN  = 0.
         SN1 = 0.

         DO 40 COL = PIXEND , PIXEND-NPIX, -1
               SN = SN + INPFRAM(COL,ROW)
40       CONTINUE

         DO 50 COL = PIXSTA, PIXSTA+NPIX
               SN1 = SN1 + INPFRAM(COL,ROW+1)
50       CONTINUE

         CONST(ROW) = SN1/SN

10    CONTINUE


C --- Constant for the central order is set to 1. and the frames 
C --- are normalized.

      CONST(NY) = 1.0

      DO 90 ROW = NY-1,1,-1

         CONST(ROW) = CONST(ROW)*CONST(ROW+1)

90    CONTINUE

      MIDORD = NY/2
      FACTOR = CONST(MIDORD)

      DO 60 ROW = 1,NY

         CONST(ROW) = CONST(ROW)/FACTOR
C         TYPE*,'Order,const.',ROW,CONST(ROW)

60    CONTINUE

      DO 70  ROW = 1,NY

         PIXSTA = ORDSTA(ROW) + BOUND(1) + 1
         PIXEND = ORDEND(ROW) - BOUND(2)

         DO 75  COL = 1 , PIXSTA-1

             INPFRAM(COL,ROW) = 0.

75       CONTINUE

         DO 80  COL = PIXSTA,PIXEND

             INPFRAM(COL,ROW) = INPFRAM(COL,ROW) * CONST(ROW)

80       CONTINUE

         DO 85 COL = PIXEND+1,NX

             INPFRAM(COL,ROW) = 0.

85       CONTINUE

70    CONTINUE

      RETURN
      END