C @(#)sqztmp.for	17.1.1.1 (ES0-DMD) 01/25/02 17:19:02
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.PURPOSE: Rebin the original image to a reasonable size to give faster         
C          execution.                                                           
C.INPUT:   AIMAGE : INPUT_A is the image frame                                  
C          NIX,...  usual descriptors of AIMAGE                                 
C.OUTPUT:  ATEMP  : an internal buffer used for rebinning of AIMAGE             
C          NSX,...  the same for ATEMP which will be managed as an image frame  
C ------------------------------------------------------------------            
      SUBROUTINE SQZTMP(AIMAGE,ATEMP,NIX,NIY,DXSTR,DYSTR,DXSTP,                 
     +                       DYSTP,NSX,NSY,SXSTR,SYSTR,SXSTP,SYSTP)             
C
      IMPLICIT         NONE
      REAL             AIMAGE(1)
      REAL             ATEMP(128,128)
      INTEGER          NIX
      INTEGER          NIY
      DOUBLE PRECISION DXSTR
      DOUBLE PRECISION DYSTR
      DOUBLE PRECISION DXSTP
      DOUBLE PRECISION DYSTP
      INTEGER          NSX
      INTEGER          NSY
      DOUBLE PRECISION SXSTR
      DOUBLE PRECISION SYSTR
      DOUBLE PRECISION SXSTP
      DOUBLE PRECISION SYSTP
C
      INTEGER          I, IF, IP, IND
      INTEGER          J, JP
      INTEGER          K
      INTEGER          L
      INTEGER          NUPX
      INTEGER          NUPY
      INTEGER          MODX
      INTEGER          MODY
      INTEGER          NORX
      INTEGER          NORY
      INTEGER          NXPIX
      INTEGER          NYPIX
      REAL             DIV
C
C *** begin code; set parameters                                                
C                                                                               
      NUPX   = NIX/128 + 1                                                      
      NUPY   = NIY/128 + 1                                                      
      MODX   = MOD(NIX,128)                                                     
      MODY   = MOD(NIY,128)                                                     
      NSX    = (NIX/NUPX)/2*2                                                   
      NSY    = (NIY/NUPY)/2*2                                                   
      NORX   = NSX*NUPX                                                         
      NORY   = NSY*NUPY                                                         
      NXPIX  = NUPX                                                             
      NYPIX  = NUPY                                                             
C                                                                               
      IF (NIX.LE.128) THEN                                                      
         NXPIX  = 1                                                             
         NSX    = NIX/2*2                                                       
         NORX   = NSX                                                           
      ELSE                                                                      
         IF (MODX.LE. (NIX-NORX)) THEN                                          
            NXPIX  = NUPX - 1                                                   
            NORX   = NIX - MODX                                                 
            NSX    = 128                                                        
         END IF                                                                 
      END IF                                                                    
C                                                                               
      IF (NIY.LE.128) THEN                                                      
         NYPIX  = 1                                                             
         NSY    = NIY/2*2                                                       
         NORY   = NSY                                                           
      ELSE                                                                      
         IF (MODY.LE. (NIY-NORY)) THEN                                          
            NYPIX  = NUPY - 1                                                   
            NORY   = NIY - MODY                                                 
            NSY    = 128                                                        
         END IF                                                                 
      END IF                                                                    
C                                                                               
      DIV    = FLOAT(NXPIX*NYPIX)                                               
      SXSTR  = DXSTR + ((NXPIX-1.)*DXSTP)/2.                                    
      SYSTR  = DYSTR + ((NYPIX-1.)*DYSTP)/2.                                    
      SXSTP  = DXSTP*NXPIX                                                      
      SYSTP  = DYSTP*NYPIX                                                      
C                                                                               
C *** squeeze the image                                                        
C                                                                               
      IF     = 1                                                                
      DO 100 J = 1,NSY                                                          
         DO 10 IND = 1,NSX                                                      
            ATEMP(IND,J) = 0.                                                   
   10    CONTINUE                                                               
C                                                                               
         DO 70 JP = 1,NYPIX                                                     
            K      = 0                                                          
            DO 50 I = 1,NORX,NXPIX                                              
               K      = K + 1                                                   
               DO 30 L = I,I + NXPIX - 1                                        
                  ATEMP(K,J) = ATEMP(K,J) + AIMAGE(IF-1+L)                      
   30          CONTINUE                                                         
   50       CONTINUE                                                            
            IF     = IF + NIX                                                   
   70    CONTINUE                                                               
C                                                                               
          DO 80 IP = 1,NSX                                                      
             ATEMP(IP,J) = ATEMP(IP,J)/DIV                                      
   80     CONTINUE                                                              
  100 CONTINUE                                                                  
C                                                                               
      RETURN                                                                    
      END