← Back to branch summary

~ubuntu-branches/debian/jessie/eso-midas/jessie

« back to all changes in this revision

Viewing changes to contrib/surfphot/src/normalize.for

  • Committer: Package Import Robot
  • Author(s): Ole Streicher
  • Date: 2014-04-22 14:44:58 UTC
  • Revision ID: package-import@ubuntu.com-20140422144458-okiwi1assxkkiz39
Tags: upstream-13.09pl1.2+dfsg
Import upstream version 13.09pl1.2+dfsg

Show diffs side-by-side

added added

removed removed

Lines of Context:
contrib/surfphot/src/normalize.for
 
1
C @(#)normalize.for     19.1 (ESO-DMD) 02/25/03 13:31:23
 
2
C===========================================================================
 
3
C Copyright (C) 1995 European Southern Observatory (ESO)
 
4
C
 
5
C This program is free software; you can redistribute it and/or 
 
6
C modify it under the terms of the GNU General Public License as 
 
7
C published by the Free Software Foundation; either version 2 of 
 
8
C the License, or (at your option) any later version.
 
9
C
 
10
C This program is distributed in the hope that it will be useful,
 
11
C but WITHOUT ANY WARRANTY; without even the implied warranty of
 
12
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
13
C GNU General Public License for more details.
 
14
C
 
15
C You should have received a copy of the GNU General Public 
 
16
C License along with this program; if not, write to the Free 
 
17
C Software Foundation, Inc., 675 Massachusetts Ave, Cambridge, 
 
18
C MA 02139, USA.
 
19
C
 
20
C Correspondence concerning ESO-MIDAS should be addressed as follows:
 
21
C       Internet e-mail: midas@eso.org
 
22
C       Postal address: European Southern Observatory
 
23
C                       Data Management Division 
 
24
C                       Karl-Schwarzschild-Strasse 2
 
25
C                       D 85748 Garching bei Muenchen 
 
26
C                       GERMANY
 
27
C===========================================================================
 
28
C
 
29
C +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
30
C.COPYRIGHT: Copyright (c) 1987 European Southern Observatory,
 
31
C                                         all rights reserved
 
32
C.IDENTIFICATION: NORMALIZE
 
33
C.LANGUAGE:       F77+ESOext
 
34
C.AUTHOR:         O.-G. Richter
 
35
C.KEYWORDS:       bulk data frame, normalization, sky background
 
36
C.PURPOSE:        Normalizes an image calibrated to relative intensity to
 
37
C                 a sky background of 1.0
 
38
C.ALGORITHM:      Histogram of max. 5000 pixels is formed and MEAN, MODE and
 
39
C                 MEDIAN are computed. The third mode is taken to be
 
40
C                 the sky background. All pixels are now divided by
 
41
C                 this background value thereby normalizing the frame
 
42
C                 to a sky background 1.0.
 
43
C.INPUT/OUTPUT:   IN_A/C/1/60    input frame
 
44
C                 OUT_A/C/1/60   output frame - if omitted, input frame 
 
45
C                                will be updated
 
46
C                 INPUTR/R/1/2   truncation values (min,max),
 
47
C                                min > max indicates no truncation wanted
 
48
C                 INPUTR/R/3/4   control values for array CRMD
 
49
C.NOTE:           Resulting background will be displayed + stored into
 
50
C                 descriptor FLAT_SKY/R/1/1 and key OUTPUTR/R/11/4 as well
 
51
creation
 
52
C.VERSION:        830712 OGR creation
 
53
C.VERSION         870928 RHW ST interfaces
 
54
C.VERSION:        871123 RHW ESO-FORTRAN Conversion
 
55
C 
 
56
C 021031        last modif
 
57
C 
 
58
C -----------------------------------------------------------------------
 
59
      PROGRAM NRMLZ
 
60
C
 
61
      IMPLICIT    NONE
 
62
C
 
63
      INTEGER     MADRID
 
64
      INTEGER     IMF1,IMF2,IMF
 
65
      INTEGER     IAC,ISTAT,N
 
66
      INTEGER     NCHA,NCHB
 
67
      INTEGER     KUN(1),KNUL
 
68
      INTEGER     NAXIS,NPIX(2)
 
69
      INTEGER*8   PNTR1,PNTR2,IPNTR
 
70
C
 
71
      DOUBLE PRECISION START(2),STEP(2)
 
72
      REAL        BGRD(4),CRMD(4),CUTS(4),TRUNC(4)
 
73
C
 
74
      CHARACTER   FRAMEA*60,FRAMEB*60
 
75
      CHARACTER   CUNIT*48,IDENT*72,HIST*80,OUTPUT*80
 
76
C
 
77
      INCLUDE     'MID_INCLUDE:ST_DEF.INC/NOLIST'
 
78
      COMMON      /VMR/MADRID(1)
 
79
      INCLUDE     'MID_INCLUDE:ST_DAT.INC/NOLIST'
 
80
C
 
81
      DATA        HIST/' '/
 
82
 9000 FORMAT('background value = ',G15.7)
 
83
C
 
84
C *** begin code
 
85
      CALL STSPRO('NORMALIZE')                                    ! init MIDAS
 
86
C
 
87
C *** read keywords
 
88
      CALL STKRDC('IN_A',1,1,60,IAC,FRAMEA,KUN,KNUL,ISTAT)
 
89
      CALL STKRDC('OUT_A',1,1,60,IAC,FRAMEB,KUN,KNUL,ISTAT)
 
90
      CALL STKRDR('INPUTR',1,2,IAC,TRUNC,KUN,KNUL,ISTAT)
 
91
      CALL STKRDR('INPUTR',3,4,IAC,CRMD,KUN,KNUL,ISTAT)
 
92
C
 
93
      IF (FRAMEA.NE.FRAMEB) THEN
 
94
         CALL STIGET(FRAMEA,D_R4_FORMAT,F_I_MODE,F_IMA_TYPE,
 
95
     2               2,NAXIS,NPIX,START,STEP,IDENT,CUNIT,
 
96
     +               PNTR1,IMF1,ISTAT)
 
97
         CALL STIPUT(FRAMEB,D_R4_FORMAT,F_O_MODE,F_IMA_TYPE,
 
98
     2               NAXIS,NPIX,START,STEP,IDENT,CUNIT,
 
99
     2               PNTR2,IMF2,ISTAT)
 
100
         CALL STDCOP(IMF1,IMF2,3,' ',ISTAT)
 
101
         CALL CPFRAM(MADRID(PNTR1),MADRID(PNTR2),NPIX(1),NPIX(2))         ! copy
 
102
         IMF    = IMF2
 
103
         IPNTR  = PNTR2
 
104
 
 
105
      ELSE                                      ! use input image frame directly
 
106
         CALL STIGET(FRAMEA,D_R4_FORMAT,F_IO_MODE,F_IMA_TYPE,
 
107
     2               2,NAXIS,NPIX,START,STEP,IDENT,CUNIT,
 
108
     +               IPNTR,IMF,ISTAT)
 
109
      END IF
 
110
C
 
111
      CALL NORMAL(MADRID(IPNTR),NPIX,CRMD,BGRD)                  ! now normalize
 
112
C
 
113
C *** display + store results
 
114
      WRITE (OUTPUT,9000) BGRD(1)
 
115
      CALL STTPUT(OUTPUT,ISTAT)
 
116
      NCHA = INDEX(FRAMEA,' ')-1
 
117
      NCHB = INDEX(FRAMEB,' ')-1
 
118
      HIST = FRAMEB(1:NCHB)//' = normalized('//FRAMEA(1:NCHA)//')'   ! app hist.
 
119
      CALL STDWRC(IMF,'HISTORY',1,HIST,-1,80,KUN,ISTAT)
 
120
      CALL STDWRR(IMF,'FLAT_SKY',BGRD,1,1,KUN,ISTAT)       ! backgrnd in keyword
 
121
      CALL STKWRR('OUTPUTR',BGRD,11,4,KUN,ISTAT)
 
122
      CALL STDRDR(IMF,'LHCUTS',1,4,IAC,CUTS,KUN,KNUL,ISTAT)
 
123
 
 
124
      DO 10 N = 1,4
 
125
         CUTS(N) = CUTS(N)/BGRD(1)
 
126
   10 CONTINUE
 
127
 
 
128
      IF (TRUNC(1).GE.TRUNC(2)) THEN
 
129
         CALL STDWRR(IMF,'LHCUTS',CUTS,1,4,KUN,ISTAT)
 
130
      ELSE
 
131
         CALL TRUNCY(MADRID(IPNTR),NPIX,TRUNC)
 
132
         CUTS(1) = MAX(CUTS(1),TRUNC(1))
 
133
         CUTS(2) = MAX(CUTS(2),TRUNC(2))
 
134
         CUTS(3) = MAX(CUTS(3),TRUNC(3))
 
135
         CUTS(4) = MAX(CUTS(4),TRUNC(4))
 
136
         CALL STDWRR(IMF,'LHCUTS',CUTS,1,4,KUN,ISTAT)
 
137
      ENDIF
 
138
C
 
139
      CALL STSEPI
 
140
      END