C @(#)satbad.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 SUBROUTINE SATBAD(A, JAPY, IBUF, I, J, LHED, RARR, MAS) C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C C C----------------------------------------------------------------------- IMPLICIT NONE INCLUDE 'MID_REL_INCL:INVENT.INC' C REAL A(1) INTEGER JAPY(1) INTEGER IBUF(4) INTEGER I INTEGER J INTEGER LHED REAL RARR(64) INTEGER MAS((-MAXSUB):MAXSUB,(-MAXSUB):MAXSUB) C INTEGER JL , JOF , JOFF , K , K1 , K2 , L , L1 , L2 REAL HCUT , LCUT , TEMP C LCUT = RARR(1) HCUT = RARR(2) JOFF = IBUF(2) - 1 C K1 = MAX( I-LHED , IBUF(1) ) L1 = MAX( J-LHED , IBUF(2) ) K2 = MIN( I+LHED , IBUF(3) ) L2 = MIN( J+LHED , IBUF(4) ) DO 10 L = L1 , L2 JL = L - J JOF = JAPY(L-JOFF) DO 20 K = K1 , K2 TEMP = A(JOF+K) IF ( TEMP .GE. HCUT ) THEN MAS(K-I,JL) = -1 ELSE IF ( TEMP .LE. LCUT ) THEN MAS(K-I,JL) = 0 ELSE MAS(K-I,JL) = 1 ENDIF 20 CONTINUE 10 CONTINUE C RETURN C END