← Back to branch summary

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

« back to all changes in this revision

Viewing changes to contrib/surfphot/src/gridima.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/gridima.for
 
1
C @(#)gridima.for       19.1 (ESO-DMD) 02/25/03 13:31:22
 
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: GRIDIMA
 
33
C.LANGUAGE:       F77+ESOext
 
34
C.AUTHOR:         D.Baade
 
35
C.KEYWORDS:       Ingeneering frames
 
36
C.PURPOSE:        Produce 2-D frame with rectangular grid subjected to
 
37
C                 "S-type" distortion
 
38
C.ALGORITHM:      trivial
 
39
C.PECULARITIES:   The size of the frame is fixed to 510 by 510 pixels as is the
 
40
C                 separation of the lines of the undistorted grid to 60 pixels
 
41
C.INPUT/OUTPUT:   The following key words are used:
 
42
C                 ALPHA/R/1/1  angle ALPHA_0 of the distortion in the following 
 
43
C                 parametrization:
 
44
C                                 ALPHA = ALPHA0 * R**2
 
45
C                 with R being the distance from the point about which
 
46
C                 the rotation takes place. ALPHA_0 to be given in degrees/pixel.
 
47
C.VERSION:        850322 DB  Creation
 
48
C.VERSION:        871123 RHW ESO-FORTRAN Conversion
 
49
C
 
50
C 021031        last modif
 
51
C 
 
52
C ---------------------------------------------------------------------
 
53
      PROGRAM GRDIMA
 
54
 
 
55
      IMPLICIT     NONE
 
56
C
 
57
      INTEGER      MADRID,IMF
 
58
      INTEGER      IAV,ISTAT
 
59
      INTEGER      NPIX(2)
 
60
      INTEGER      NAXIS
 
61
      INTEGER      KUN,KNUL
 
62
      INTEGER*8    IPNTR
 
63
C
 
64
      CHARACTER    IDENT*72,CUNIT*48,IMAG*64
 
65
C
 
66
      REAL         ALPHA0
 
67
      REAL         LHCUTS(4)
 
68
      DOUBLE PRECISION START(2),STEP(2)
 
69
C
 
70
      INCLUDE      'MID_INCLUDE:ST_DEF.INC/NOLIST'
 
71
      COMMON       /VMR/MADRID(1)
 
72
      INCLUDE      'MID_INCLUDE:ST_DAT.INC/NOLIST'
 
73
C
 
74
      DATA         START/1.,1./
 
75
      DATA         STEP/1.,1./
 
76
      DATA         NAXIS/2/
 
77
      DATA         NPIX/510,510/
 
78
      DATA         LHCUTS/0.,100.,0.,100./
 
79
      DATA         IMAG/'GRID'/
 
80
      DATA         IDENT/'GRID'/
 
81
      DATA         CUNIT/'FLUX'/
 
82
C
 
83
C *** begin code
 
84
      CALL STSPRO('GRIDIMA')                        ! get into midas environment
 
85
      CALL STKRDR('ALPHA',1,1,IAV,ALPHA0,KUN,KNUL,ISTAT)  ! get distortion angle
 
86
      ALPHA0 = ALPHA0*3.14159/180.                        !   convert to radians
 
87
      CALL STIPUT(IMAG,D_R4_FORMAT,F_O_MODE,F_IMA_TYPE,NAXIS,
 
88
     2            NPIX,START,STEP,IDENT,CUNIT,IPNTR,IMF,ISTAT)
 
89
C
 
90
C *** we already know (by definition) the cuts. let's set them now:
 
91
      CALL FLLGRD(MADRID(IPNTR),ALPHA0)            ! call fillgrid to do the job
 
92
      CALL STDWRR(IMF,'LHCUTS',LHCUTS,1,4,KUN,ISTAT)
 
93
C
 
94
      CALL STSEPI                            ! release files and update keywords
 
95
      END