C @(#)getpix.for	19.1 (ES0-DMD) 02/25/03 13:19:39
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
      SUBROUTINE EXTRA2(A,NPIX,IMAGE,DATA,MXPIX,ISM,IFLAG,ISI)                  
C+++                                                                            
C.AUTHOR:         Rein H. Warmels, ESO-Garching, based on existing code by 
C                 Ch.Ounnas
C.PURPOSE:        extract a subimage from a MIDAS frame , smoothes it (option)  
C                 Finally fills a transmitted array (1 dimension)               
C.ALGORITHM:      extracts a subimage from a MIDAS frame and fills an array     
C                 if required  smoothes the subframe before with a running      
C                 2-d average.                                                  
C.COMMENTS:       none
C.VERSION:        890117 RHW  Adjusted for portable version
C.VERSION:        910115 RHW  IMPLICIT NONE added
C---  
      IMPLICIT NONE 
C
      REAL     A(1)                      ! IN: entry to the frame               
      INTEGER  NPIX(3)                   ! IN: standard descriptor of frame 
      INTEGER  IMAGE(4)                  ! IN: contains in pixels units
      INTEGER  MXPIX                     ! IN: max size                         
      REAL     DATA(MXPIX,MXPIX)         ! OUT: data array
      INTEGER  ISM                       ! IN: smooth. parameter (if .le. 1 np) 
      INTEGER  IFLAG                     ! IN: 0: no rot.; 1: 90 deg. rotation  
      INTEGER  ISI                       ! IN: total size of the data array     

C
      INTEGER  MADRID(1)
      INTEGER  NX1, NX2, NY1, NY2
      INTEGER  NX, NY
      INTEGER  ILIS, IOFF
      INTEGER  IX, IY, KX, KY, ISX, ISY, IXG, IYG
      INTEGER  II
      INTEGER  NAV
      REAL     AVER
C                                                                               
      COMMON   /VMR/MADRID                                                  
C                                                                               
C *** check correct input                                                       
      NX1      = MIN(IMAGE(1),IMAGE(2))                                         
      NX2      = MAX(IMAGE(1),IMAGE(2))                                         
      IMAGE(1) = NX1                                                            
      IMAGE(2) = NX2                                                            
      NY1      = MIN(IMAGE(3),IMAGE(4))                                         
      NY2      = MAX(IMAGE(3),IMAGE(4))                                         
      IMAGE(3) = NY1                                                            
      IMAGE(4) = NY2                                                            
C                                                                               
C ***
      NX     = IMAGE(2) - IMAGE(1) + 1                                          
      IF (NX.EQ.1) THEN                       !  1-dim image rotate over 90 deg.
         IFLAG  = 1                                                             
      END IF                                                                    
      NY     = IMAGE(4) - IMAGE(3) + 1                                          
C                                                                               
C *** check image input                                                         
      IF (NX.LE.1) THEN                                                         
         RETURN                                                                 
      END IF                                                                    
C                                                                               
      IF (NY.LE.1) THEN                                                         
         RETURN                                                                 
      END IF                                                                    
C                                                                               
C *** set and correct smoothing parameter                                       
      IF (ISM.EQ.0) THEN                                                        
         ISM    = 1                                                             
      END IF                                                                    
      ILIS   = 2 * (ISM/2) + 1                                                  
      IOFF   = ILIS/2                                                           
C                                                                               
C *** smoothes and read frame                                                   
      IF (ISM.GE.2) THEN                                                        
         DO 40 IX = IMAGE(1),IMAGE(2)                                           
            DO 30 IY = IMAGE(3),IMAGE(4)                                        
               AVER   = 0.                                                      
               NAV    = 0                                                       
               DO 20 ISX = 1,ILIS                                               
                  DO 10 ISY = 1,ILIS                                            
                     IXG    = IX + ISX - IOFF - 1                               
                     IYG    = IY + ISY - IOFF - 1                               
C                                                                               
C *** check if no reading out of the frame is done                              
                     IF (IXG.LE.0 .OR. IXG.GT.NPIX(1)) THEN                     
                        GO TO 20                                                
                     END IF                                                     
                     IF (IYG.LE.0 .OR. IYG.GT.NPIX(2)) THEN                     
                        GO TO 10                                                
                     END IF                                                     
                     NAV    = NAV + 1                                           
                     II     = (IYG-1)*NPIX(1) + IXG                             
                     AVER   = AVER + A(II)                                      
   10             CONTINUE                                                      
   20          CONTINUE                                                         
               AVER   = AVER/FLOAT(NAV)                                         
               KX     = IX - IMAGE(1) + 1                                       
               KY     = IY - IMAGE(3) + 1                                       
C                                                                               
C *** rotate over 90 deg. in equired                                            
               IF (IFLAG.EQ.0) THEN                                             
                  DATA(KX,KY) = AVER                                            
               ELSE                                                             
                  DATA(KY,NX-KX+1) = AVER                                       
               END IF                                                           
   30       CONTINUE                                                            
   40    CONTINUE                                                               
C                                                                               
      ELSE                                                                      
         DO 60 IY = IMAGE(3),IMAGE(4)                                           
            KY     = IY - IMAGE(3) + 1                                          
            DO 50 IX = IMAGE(1),IMAGE(2)                                        
               KX     = IX - IMAGE(1) + 1                                       
               II     = IX + (IY-1)*NPIX(1)                                     
C                                                                               
C *** rotate over 90 deg. in equired                                            
               IF (IFLAG.EQ.0) THEN                                             
                  DATA(KX,KY) = A(II)                                           
               ELSE                                                             
                  DATA(KY,NX-KX+1) = A(II)                                      
               END IF                                                           
   50       CONTINUE                                                            
   60    CONTINUE                                                               
      END IF                                                                    
                                                                                
      RETURN                                                                    
      END                                                                       

      SUBROUTINE PIXVAL(FMES,ISI,NPL,IPL,IL,VAL)                                
C+++                                                                            
C.PURPOSE:   Read a pixel in a frame into an real variable
C.AUTHOR:    Rein H. Warmels, ESO-Garching
C.VERSION:   ?????? RHW Creation
C.VERSION:   890117 RHW documented
C.COMMENTS:  none
C---                                                                            
      IMPLICIT NONE
      REAL     FMES(1)                                                       
      INTEGER  ISI
      INTEGER  NPL
      INTEGER  IPL
      INTEGER  IL
      REAL     VAL
C
      INTEGER  MADRID(1)
      INTEGER  INDEX
      COMMON  /VMR/MADRID
C ***
      IF (IPL.GT.NPL) THEN                                                      
          VAL    = 0.                                                           
      ELSE                                                                      
          INDEX  = (IL-1)*NPL + IPL                                             
          VAL    = FMES(INDEX)                                                  
      END IF                                                                    
C                                                                               
      RETURN                                                                    
      END                                                                       


      SUBROUTINE LIBA(NL,NPL,NPL1,NPL2,NPL3,FMES,RMES)                          
C+++                                                                            
C.PURPOSE:  Write an array into a frame
C.AUTHOR:   ???
C.VERSION:  ?????? ??? created
C.VERSION:  890117 RHW documented
C.COMMENTS: none
C---
      IMPLICIT   NONE
      INTEGER    NL
      INTEGER    NPL
      INTEGER    NPL1
      INTEGER    NPL2
      INTEGER    NPL3
      REAL       FMES(1)
      REAL       RMES(1)                                                

      INTEGER    MADRID(1)
      INTEGER    NPD, NPF
      INTEGER    K, I
C
      COMMON     /VMR/MADRID                                                 
C 
C ***
      NPD = NPL* (NL-1) + NPL1                                                  
      NPF = NPD + NPL2 - NPL1                                                   
      K   = 0                                                                   
C                                                                               
      DO 10 I = NPD,NPF,NPL3                                                    
         K      = K + 1                                                         
         FMES(I) = RMES(K)                                                      
   10 CONTINUE                                                                  
C                                                                               
      RETURN                                                                    
      END                                                                       

      SUBROUTINE LIRE(NL,NPL,NPL1,NPL2,NPL3,FMES,RMES)                          
C+++                                                                            
C.PURPOSE:  Write part of a frame into an array
C.AUTHOR:   ???
C.VERSION:  ?????? ??? created
C.VERSION:  890117 RHW documented
C.COMMENTS: none
C---
      IMPLICIT   NONE
      INTEGER    NL
      INTEGER    NPL
      INTEGER    NPL1
      INTEGER    NPL2
      INTEGER    NPL3
      REAL       FMES(1)
      REAL       RMES(1)                                                

      INTEGER    MADRID(1)
      INTEGER    NPD, NPF, K, I 
C
      COMMON     /VMR/MADRID                                                 
C
C ***
      NPD = NPL* (NL-1) + NPL1                                                  
      NPF = NPD + NPL2 - NPL1                                                   
      K   = 0                                                                   
C                                                                               
      DO 10 I = NPD,NPF,NPL3                                                    
         K       = K + 1                                                        
         RMES(K) = FMES(I)                                                      
   10 CONTINUE                                                                  
C                                                                               
      RETURN                                                                    
      END                                                                       
