C @(#)rctscl.for 17.1.1.1 (ES0-DMD) 01/25/02 17:19:01 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 RCTSCL(SUB,IN) C +++ C.PURPOSE: This subroutine compares the sum of the fluxes in the individual C subpixels to the flux in the original input pixel. The fluxes in C the subpixels are then scaled such that their sum equals the C original flux. Hence, flux conservation should be achieved on the C pixel scale. C --- IMPLICIT NONE REAL SUB(3,3) REAL IN C REAL SUM,SCALE INTEGER K INTEGER L C SCALE = 1 SUM = SUB(1,1) + SUB(1,2) + SUB(1,3) + SUB(2,1) + SUB(2,2) + + SUB(2,3) + SUB(3,1) + SUB(3,2) + SUB(3,3) C IF (SUM.NE.0) THEN ! assume sum does not vanish due to neg. fluxes ... SCALE = IN/SUM ENDIF C DO 20 K = 1,3 DO 10 L = 1,3 SUB(K,L) = SUB(K,L)*SCALE 10 CONTINUE 20 CONTINUE C RETURN END