C @(#)irstilt.for	17.1.1.1 (ES0-DMD) 01/25/02 17:53:06
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
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.COPYRIGHT   (C) 1992 European Southern Observatory
C.IDENT       .for
C.AUTHOR      E. Oliva,  Firenze-Arcetri
C.KEYWORDS    Spectroscopy, IRSPEC
C
C.PURPOSE     Execute command  ...
C
C.ALGORITHM
C
C
C.INPUT/OUTPUT
C
C
C.VERSION     1.0    Creation     02.09.1992   E. Oliva
C
C-------------------------------------------------------
C
      PROGRAM TILT
      IMPLICIT REAL(A-H,O-Z)
      IMPLICIT INTEGER(I-N)

      CHARACTER*60 FRAMEI,FRAMEO
      CHARACTER*64 CUNIT
      CHARACTER*72 IDENT
      INTEGER*8 INPNTR,OUPNTR
      INTEGER NPIX(2)
      DOUBLE PRECISION START(2),STEP(2),DCW
      DIMENSION GRARUL(2)
      COMMON/ISTPAR/COSG_SIG(2),SING0,CSI0
      COMMON /VMR/ MADRID(1)

      INCLUDE 'MID_INCLUDE:ST_DEF.INC'
      INCLUDE 'MID_INCLUDE:ST_DAT.INC'

      DATA MAXDIM/2/

      IRET=1
      CALL STSPRO('TILT')
C
C GET NAME OF INPUT FRAME AND MAP IT
C
      CALL STKRDC('framei',1,1,60,IRET,FRAMEI,KUNIT,KNUL,ISTAT)
      CALL CLNFRA(FRAMEI,FRAMEI,0)
      CALL STIGET(FRAMEI,D_R4_FORMAT,F_I_MODE,F_IMA_TYPE,MAXDIM,
     ,          NAXIS,NPIX,START,STEP,
     ,          IDENT,CUNIT,INPNTR,NIN,ISTAT)
      IF(NAXIS.NE.2) 
     +     CALL STETER(1,'Input frame must be 2-D')
C
C GET NAME OF OUTPUT FRAME AND MAP IT 
C
      CALL STKRDC('frameo',1,1,60,IRET,FRAMEO,KUNIT,KNUL,ISTAT)
      CALL CLNFRA(FRAMEO,FRAMEO,0)
      CALL STIPUT(FRAMEO,D_R4_FORMAT,F_O_MODE,F_IMA_TYPE,
     ,          NAXIS,NPIX,START,STEP,
     ,          IDENT,CUNIT,OUPNTR,NOU,ISTAT)
C
C Get values of gamma0,csi0,grarul
C and compute COSG_SIG(1:2)=cos(gamma0)*1000/grarul
C             SING0=sin(gamma0)
C
      CALL STKRDR('Igamma0',1,1,IRET,GAMMA0,KUNIT,KNUL,ISTAT)
      SING0=SIN(GAMMA0)
      CALL STKRDR('Igrarul',1,2,IRET,GRARUL,KUNIT,KNUL,ISTAT)
      DO I=1,2
        COSG_SIG(I)=COS(GAMMA0)*1000/GRARUL(I)
      ENDDO
      CALL STKRDR('Icsi0',1,1,IRET,R4,KUNIT,KNUL,ISTAT)
      CSI0=R4
C
C Get key which contain the reference row # (i.e. the #
C of the row which is left untouched
C
      CALL STKRDI('rowref',1,1,IRET,IRREF,KUNIT,KNUL,ISTAT)
C
C GET NAME OF KEY WHICH MIGHT CONTAIN THE VALUE OF THE TANGENT
C OF THE TILT ANGLE (CSI) ENTERED BY THE USER.
C IF = 0 TAKE THE VALUES OF CW, C GRAT # AND ORDER # C FROM THE 
C FILE DESCRIPTORS AND COMPUTE CSI ACCORDING TO THE PROPER 
C FORMULA (SEE FUNCTION VALUE_TILT).
C
      CALL STKRDR('angle',1,1,IRET,CSI,KUNIT,KNUL,ISTAT)
C
C Get values of grating#
C               order#
C               center wavelength
C
      IF(CSI.EQ.0.) THEN
        CALL STKRDI('ngrat',1,1,IRET,IGRAT,KUNIT,KNUL,ISTAT)
        CALL STKRDI('order',1,1,IRET,IORDER,KUNIT,KNUL,ISTAT)
        CALL STKRDD('wlcen',1,1,IRET,DCW,KUNIT,KNUL,ISTAT)
        CW=DCW
        CSI=VALUE_TILT(CW,IGRAT,IORDER)
      ENDIF
C
C CALL ROUTINE WHICH CORRECT SLIT TILT BY MEANS OF LINEAR REBINNING 
C ROW BY ROW.
C
      CALL RECTIFY(MADRID(INPNTR),MADRID(OUPNTR),
     ,           NPIX(1),NPIX(2),CSI,IRREF)
C
C RELEASE FILES, UPDATE KEYWORDS AND EXIT
C
      CALL STSEPI
      END
C
C
C
      SUBROUTINE RECTIFY(A,B,NX,NY,CSI,IRREF)
C
C RECTIFY THE SLIT, I.E. LEAVE THE SCAN-LINE #IRREF OF THE
C IMAGE UNTOUCHED AND SHIFT (=LINEAR REBIN....) THE OTHERS
C BY CSI*DISTANCE FROM CENTRAL COLUMN.
C
      IMPLICIT REAL(A-H,O-Z)
      IMPLICIT INTEGER(I-N)

      DIMENSION A(NX,NY),B(NX,NY)
C
C SET OUTPUT IMAGE TO ZERO
C
      DO J=1,NY
        DO I=1,NX
          B(I,J)=0.0
        ENDDO
      ENDDO
C
      ICROW=IRREF
      DO IY=1,NY
        SHIFT=CSI*FLOAT(ICROW-IY)
        DO IX=1,NX
          A1=FLOAT(IX)+SHIFT
          IA1=AINT(A1)
          IF(A1.LT.0.) IA1=IA1-1
          IF(IA1.LT.1) THEN
            B(IX,IY)=A(1,IY)
            GO TO 10
          ENDIF
          IF(IA1.GT.(NX-1)) THEN
            B(IX,IY)=A(NX,IY)
            GO TO 10
          ENDIF
          W1=1-A1+FLOAT(IA1)
          IA2=IA1+1
          W2=1.-W1
          X1=A(IA1,IY)
          X2=A(IA2,IY)
          B(IX,IY)=W1*X1+W2*X2
10        CONTINUE
        ENDDO
      ENDDO
C
      RETURN
      END
C
C
      FUNCTION VALUE_TILT(WAVE,NGRAT,IORDER)
C
      IMPLICIT REAL(A-H,O-Z)
      IMPLICIT INTEGER(I-N)

      COMMON/ISTPAR/COSG_SIG(2),SING0,CSI0
      CHARACTER*80 OUTPUT

      ORDER=IORDER
      CSI=TAN
     +(ATAN(2.*SING0/SQRT((2.*COSG_SIG(NGRAT)/ORDER/WAVE)**2-1.))-CSI0)
      WRITE(OUTPUT,100) CSI
100   FORMAT('Assumed value of tan(tilt) : ',F7.4)
      CALL STTPUT(OUTPUT,ISTAT)
      VALUE_TILT=CSI
      RETURN
      END