C @(#)irsshift.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       irsshift.for
C.AUTHOR      E. Oliva,  Firenze-Arcetri
C.KEYWORDS    Spectroscopy, IRSPEC
C
C.PURPOSE     Shift a frame in X by a given number of pixels.
C
C.ALGORITHM   Simple.
C
C
C.INPUT/OUTPUT
C
C
C.VERSION     1.0    Creation     28.09.1992   E. Oliva
C
C-------------------------------------------------------
C
      PROGRAM SKYBUB
      IMPLICIT REAL(A-H,O-Z)
      IMPLICIT INTEGER(I-N)
      
      CHARACTER*64 CUNIT
      CHARACTER*72 IDENT
      CHARACTER*60 FIN,FOUT
      COMMON /VMR/ MADRID(1)
      INTEGER NPIX(3)
      INTEGER*8 OUPNTR
      DOUBLE PRECISION START(3),STEP(3)
     

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

      DATA MAXDIM/2/

      IRET=1
      CALL STSPRO('SHIFT')
C
C Input frame.
C
C      CALL STKRDC('fin',1,1,60,IRET,FOBJ,KUNIT,KNUL,ISTAT)
      CALL CLNFRA('&fs',FIN,0)
      CALL STIGET(FIN,D_R4_FORMAT,F_I_MODE,F_IMA_TYPE,MAXDIM,
     ,            NAXIS,NPIX,START,STEP,
     ,            IDENT,CUNIT,INPNTR,NOBJ,ISTAT)
      NX=NPIX(1)
      NY=NPIX(2)
C
C Output frame
C
C      CALL STKRDC('fout',1,1,60,IRET,FOUT,KUNIT,KNUL,ISTAT)
      CALL CLNFRA('&fr',FOUT,0)
      CALL STIPUT(FOUT,D_R4_FORMAT,F_O_MODE,F_IMA_TYPE,
     ,            NAXIS,NPIX,START,STEP,
     ,            IDENT,CUNIT,OUPNTR,NOUT,ISTAT)
C
C Get value of shift (in pixels)
C
      CALL STKRDR('shift',1,1,IRET,SHIFT,KUNIT,KNUL,ISTAT)
C
C Call routine which shifts
C
      CALL SH(MADRID(INPNTR),MADRID(OUPNTR),NX,NY,SHIFT)
C
C RELEASE FILES, UPDATE KEYWORDS AND EXIT
C
      CALL STSEPI
      END
C
C
C
      SUBROUTINE SH(A,B,NX,NY,SHIFT)
C
      IMPLICIT REAL(A-H,O-Z)
      IMPLICIT INTEGER(I-N)

      DIMENSION A(NX,NY),B(NX,NY)
C
      IF(SHIFT.EQ.0.0) RETURN
C
      DO IY=1,NY
        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) 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

      RETURN
      END