C @(#)skymod.for	17.1.1.1 (ES0-DMD) 01/25/02 17:15:45
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.IDENTIFICATION
C  subroutine SKYMOD         version 1.0         880510
C  A. Kruszewski             Warsaw U. Obs.
C.PURPOSE
C  Calculates sky background level by means of subroutine MODE.
C  Do not use central region of subarray.
C.INPUT/OUTPUT
C  input arguments
C  A           real*4 array        image buffer
C  JAPY        integer*4 array     pointers to image lines
C  JBS         integer*4           first line in buffer
C  IXYU        integer*4           limits of used area
C  I           integer*4           x-coordinate of an object
C  J           integer*4           y-coordinate of an object
C  CRMD        integer*4 array     control parameters used by MODE
C  IHED        integer*4           half edge size of used subarray
C  IFULL       integer*4           all pixels used when IFULL=1
C  output arguments
C  BGRD        real*4              sky background
C-----------------------------------------------------------------------
      SUBROUTINE SKYMOD(A, JAPY, IBUF, I, J, CRMD,
     &                                    IHED, IFULL, BGRD)
C
      IMPLICIT NONE
      INCLUDE  'MID_REL_INCL:INVENT.INC/NOLIST'
C
      INTEGER   I , IBUF(4) , IFULL , IHED , IOFF , IRED
      INTEGER   J , JAPY(1) , JOF , JOFF
      INTEGER   K , K1 , K2 , K3 , K4 , K5 , K6
      INTEGER   L , L1 , L2 , L3 , L4 , L5 , L6 , LM
      INTEGER   N , NPIX
C
      REAL      A(1)
      REAL      B(4*MAXSUB**2) , BGRD
      REAL      CRMD(3)
      REAL      SIGMA
C
C ******      Find offsets.
C
      JOFF = IBUF(2) - 1
      IOFF = IBUF(1) - 1
C
C ******      Calculate size LM of not used central region.
C
      IF ( IFULL .EQ. 0 ) THEN
          LM = IHED/2 + 1
      ENDIF
C
C ******      Set limits of used subarray.
C
      K1 = MAX( IBUF(1) , I-IHED )
      K6 = MIN( IBUF(3) , I+IHED )
      L1 = MAX( IBUF(2) , J-IHED )
      L6 = MIN( IBUF(4) , J+IHED )
      IF ( IFULL .EQ. 0 ) THEN
          K2 = MAX( IBUF(1)-1 , I-LM-1 )
          K3 = MAX( IBUF(1) , I-LM )
          K4 = MIN( IBUF(3) , I+LM )
          K5 = MIN( IBUF(3)+1 , I+LM+1 )
          L2 = MAX( IBUF(2)-1 , J-LM-1 )
          L3 = MAX( IBUF(2) , J-LM )
          L4 = MIN( IBUF(4) , J+LM )
          L5 = MIN( IBUF(4)+1 , J+LM+1 )
      ENDIF
C
C ******      Calculate number of pixels.
C
      IF ( IFULL .EQ. 0 ) THEN
          NPIX = (K6-K1+1)*(L6-L1+1) - (K4-K3+1)*(L4-L3+1)
      ELSE
          NPIX = (K6-K1+1) * (L6-L1+1)
      ENDIF
      IRED = ( (NPIX-1) / (4*MAXSUB*MAXSUB) ) + 1
C
C ******      Pick out usable pixels.
C
      N = 0
      IF ( IFULL .EQ. 1 ) THEN
          DO 20 L = L1 , L6
            JOF = JAPY(L-JOFF)
            DO 21 K = K1 , K6
                IF ( IRED .EQ. 1 .OR. MOD(L+K,IRED) .EQ. 0 ) THEN
                  N = N + 1
                  B(N) = A(JOF+K)
                ENDIF
   21            CONTINUE 
   20          CONTINUE
      ELSE
          DO 10 L = L1 , L2
            JOF = JAPY(L-JOFF)
            DO 11 K = K1 , K6
                IF ( IRED .EQ. 1 .OR. MOD(L+K,IRED) .EQ. 0 ) THEN
                  N = N + 1
                  B(N) = A(JOF+K)
                ENDIF
   11            CONTINUE 
   10          CONTINUE
            DO 12 L = L3 , L4
            JOF = JAPY(L-JOFF)
            DO 13 K = K1 , K2
                IF ( IRED .EQ. 1 .OR. MOD(L+K,IRED) .EQ. 0 ) THEN
                  N = N + 1
                  B(N) = A(JOF+K)
                ENDIF
   13            CONTINUE 
              DO 14 K = K5 , K6
                IF ( IRED .EQ. 1 .OR. MOD(L+K,IRED) .EQ. 0 ) THEN
                  N = N + 1
                  B(N) = A(JOF+K)
                ENDIF
   14            CONTINUE 
   12          CONTINUE
            DO 15 L = L5 , L6
            JOF = JAPY(L-JOFF)
            DO 16 K = K1 , K6
                IF ( IRED .EQ. 1 .OR. MOD(L+K,IRED) .EQ. 0 ) THEN
                  N = N + 1
                  B(N) = A(JOF+K)
                ENDIF
   16            CONTINUE 
   15          CONTINUE
        ENDIF
C
C ******      Calculate mode BGRD.
C
      CALL MODE( B , N , CRMD , BGRD , SIGMA )
C
      RETURN
C
      END