C @(#)normalize.for 17.1.1.1 (ES0-DMD) 01/25/02 17:19:21 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.COPYRIGHT: Copyright (c) 1987 European Southern Observatory, C all rights reserved C.IDENTIFICATION: NORMALIZE C.LANGUAGE: F77+ESOext C.AUTHOR: O.-G. Richter C.KEYWORDS: bulk data frame, normalization, sky background C.PURPOSE: Normalizes an image calibrated to relative intensity to C a sky background of 1.0 C.ALGORITHM: Histogram of max. 5000 pixels is formed and MEAN, MODE and C MEDIAN are computed. The third mode is taken to be C the sky background. All pixels are now divided by C this background value thereby normalizing the frame C to a sky background 1.0. C.INPUT/OUTPUT: IN_A/C/1/60 input frame C OUT_A/C/1/60 output frame - if omitted, input frame C will be updated C INPUTR/R/1/2 truncation values (min,max), C min > max indicates no truncation wanted C INPUTR/R/3/4 control values for array CRMD C.NOTE: Resulting background will be displayed + stored into C descriptor FLAT_SKY/R/1/1 and key OUTPUTR/R/11/4 as well creation C.VERSION: 830712 OGR creation C.VERSION: ?????? KB ??? C.VERSION 870928 RHW ST interfaces C.VERSION: 871123 RHW ESO-FORTRAN Conversion C.VERSION: 900508 RHW Portable ST interface C ----------------------------------------------------------------------- PROGRAM NRMLZ C IMPLICIT NONE C INTEGER MADRID INTEGER PNTR1,PNTR2,IPNTR,IMF1,IMF2,IMF INTEGER IAC,ISTAT,N INTEGER NCHA,NCHB INTEGER KUN(1),KNUL INTEGER NAXIS,NPIX(2) C DOUBLE PRECISION START(2),STEP(2) REAL BGRD(4),CRMD(4),CUTS(4),TRUNC(4) C CHARACTER FRAMEA*60,FRAMEB*60 CHARACTER CUNIT*48,IDENT*72,HIST*80,OUTPUT*80 C INCLUDE 'MID_INCLUDE:ST_DEF.INC/NOLIST' COMMON /VMR/MADRID(1) INCLUDE 'MID_INCLUDE:ST_DAT.INC/NOLIST' C DATA HIST/' '/ 9000 FORMAT('background value = ',G15.7) C C *** begin code CALL STSPRO('NORMALIZE') ! init MIDAS C C *** read keywords CALL STKRDC('IN_A',1,1,60,IAC,FRAMEA,KUN,KNUL,ISTAT) CALL STKRDC('OUT_A',1,1,60,IAC,FRAMEB,KUN,KNUL,ISTAT) CALL STKRDR('INPUTR',1,2,IAC,TRUNC,KUN,KNUL,ISTAT) CALL STKRDR('INPUTR',3,4,IAC,CRMD,KUN,KNUL,ISTAT) C IF (FRAMEA.NE.FRAMEB) THEN CALL STIGET(FRAMEA,D_R4_FORMAT,F_I_MODE,F_IMA_TYPE, 2 2,NAXIS,NPIX,START,STEP,IDENT,CUNIT, + PNTR1,IMF1,ISTAT) CALL STIPUT(FRAMEB,D_R4_FORMAT,F_O_MODE,F_IMA_TYPE, 2 NAXIS,NPIX,START,STEP,IDENT,CUNIT, 2 PNTR2,IMF2,ISTAT) CALL STDCOP(IMF1,IMF2,3,' ',ISTAT) CALL CPFRAM(MADRID(PNTR1),MADRID(PNTR2),NPIX(1),NPIX(2)) ! copy IMF = IMF2 IPNTR = PNTR2 ELSE ! use input image frame directly CALL STIGET(FRAMEA,D_R4_FORMAT,F_IO_MODE,F_IMA_TYPE, 2 2,NAXIS,NPIX,START,STEP,IDENT,CUNIT, + IPNTR,IMF,ISTAT) END IF C CALL NORMAL(MADRID(IPNTR),NPIX,CRMD,BGRD) ! now normalize C C *** display + store results WRITE (OUTPUT,9000) BGRD(1) CALL STTPUT(OUTPUT,ISTAT) NCHA = INDEX(FRAMEA,' ')-1 NCHB = INDEX(FRAMEB,' ')-1 HIST = FRAMEB(1:NCHB)//' = normalized('//FRAMEA(1:NCHA)//')' ! app hist. CALL STDWRC(IMF,'HISTORY',1,HIST,-1,80,KUN,ISTAT) CALL STDWRR(IMF,'FLAT_SKY',BGRD,1,1,KUN,ISTAT) ! backgrnd in keyword CALL STKWRR('OUTPUTR',BGRD,11,4,KUN,ISTAT) CALL STDRDR(IMF,'LHCUTS',1,4,IAC,CUTS,KUN,KNUL,ISTAT) DO 10 N = 1,4 CUTS(N) = CUTS(N)/BGRD(1) 10 CONTINUE IF (TRUNC(1).GE.TRUNC(2)) THEN CALL STDWRR(IMF,'LHCUTS',CUTS,1,4,KUN,ISTAT) ELSE CALL TRUNCY(MADRID(IPNTR),NPIX,TRUNC) CUTS(1) = MAX(CUTS(1),TRUNC(1)) CUTS(2) = MAX(CUTS(2),TRUNC(2)) CUTS(3) = MAX(CUTS(3),TRUNC(3)) CUTS(4) = MAX(CUTS(4),TRUNC(4)) CALL STDWRR(IMF,'LHCUTS',CUTS,1,4,KUN,ISTAT) ENDIF C CALL STSEPI END