← Back to branch summary

~ubuntu-branches/ubuntu/wily/eso-midas/wily-proposed

« back to all changes in this revision

Viewing changes to stdred/mos/proc/mosdefine.prg

  • 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:
stdred/mos/proc/mosdefine.prg
 
1
! @(#)mosdefine.prg     19.1 (ESO-DMD) 02/25/03 14:26:43
 
2
! +++++++++++++++++++++++++++++++++++++++++++++++++
 
3
!.COPYRIGHT    (C) 1994 Landessternwarte Heidelberg
 
4
!.IDENT        mosdefine.prg
 
5
!.AUTHORS      Sabine Moehler (LSW)
 
6
!              Otmar Stahl (LSW)
 
7
!.KEYWORDS     Spectroscopy, MOS
 
8
!  
 
9
!.PURPOSE      execute the command DEFINE/MOS
 
10
!
 
11
!.VERSION      1.0 Creation 02/07/94
 
12
! 
 
13
! DEFINE/MOS image mos_table windows_table threshold window binning plot_option
 
14
!
 
15
! -------------------------------------------------
 
16
!
 
17
CROSSREF OBJECT MOS WINDOWS THRESH WIND XBIN CENTMET
 
18
!
 
19
DEFINE/PARAM P1 {OBJ}      IMAGE   "Enter input image:"
 
20
DEFINE/PARAM P2 {MOS}      TABLE   "Enter MOS table:"
 
21
DEFINE/PARAM P3 {WINDOWS}   TABLE   "Enter output table:"
 
22
DEFINE/PARAM P4 {THRESH}   NUMBER  "Threshold:"
 
23
DEFINE/PARAM P5 {WIND}     NUMBER  "Window:"
 
24
DEFINE/PARAM P6 {XBIN}     NUMBER  "binning in X:"
 
25
DEFINE/PARAM P7 {SCAN_POS} NUMBER  "center for scan (world coordinates)"
 
26
DEFINE/PARAM P8 0.           NUMBER  "Plot option"
 
27
!-------------------------------------------------
 
28
! Plot parameters
 
29
!-------------------------------------------------
 
30
DEFINE/LOCAL PLOTPAR1/I/1/1 0.
 
31
DEFINE/LOCAL PLOTPAR2/I/1/1 0.
 
32
DEFINE/LOCAL PLOTPAR3/I/1/1 0.
 
33
DEFINE/LOCAL PLOTPAR4/I/1/1 0.
 
34
define/local tmp1/d/1/1 0.
 
35
define/local tmp2/i/1/2 0.,0.
 
36
define/local tmp3/i/1/1 0.
 
37
define/local tmp4/i/1/1 0.
 
38
!       Continue flag
 
39
DEFINE/LOCAL CONT/C/1/1 y
 
40
!       Decision keyword
 
41
DEFINE/LOCAL PATH/I/1/2 0.,0.
 
42
!       Counter
 
43
DEFINE/LOCAL I/I/1/1 0
 
44
DEFINE/LOCAL J/I/1/1 0
 
45
!       Position keyword
 
46
DEFINE/LOCAL POSR/R/1/3 0.,0.,0.
 
47
!       Qualifier keyword
 
48
DEFINE/LOCAL QUALIF/C/1/4  " " all
 
49
!       Scan keyword
 
50
DEFINE/LOCAL SCAN/D/1/1 0.
 
51
!       Selection keyword
 
52
DEFINE/LOCAL SELECT/I/1/1 0.
 
53
!       Keyword to determine whether slitlet has been searched
 
54
DEFINE/LOCAL FOUND/I/1/1 0.
 
55
!
 
56
!define/local OUT_A/c/1/60 "{p3}"
 
57
WRITE/KEYW QUALIF {MID$CMND(11:14)}
 
58
WRITE/KEYW IN_A  {P1}
 
59
WRITE/KEYW IN_B  {P2}
 
60
WRITE/KEYW OUT_A {P3}
 
61
define/local OUT_D/c/1/60 "{P3}"
 
62
WRITE/KEYW INPUTI {P5},{P6},{P8}
 
63
WRITE/KEYW INPUTR {P4}
 
64
WRITE/KEYW SCAN {P7}
 
65
 
 
66
COPY/DK {IN_A} START/D/1/1 PLOTPAR1
 
67
COPY/DK {IN_A} STEP/D/1/1 TMP1
 
68
COPY/DK {IN_A} NPIX/I/1/2 TMP2
 
69
 
 
70
IF SCAN .eq. 0 THEN
 
71
  SCAN = TMP2/2*TMP1+PLOTPAR1
 
72
ENDIF
 
73
!
 
74
RUN STD_EXE:MOSDEFINE
 
75
!-------------------------------------------------------------------------------
 
76
! Plot options 
 
77
!-------------------------------------------------------------------------------
 
78
 
 
79
IF {INPUTI(3)} .eq. 1 .or. {INPUTI(3)} .eq. 3 THEN
 
80
 
 
81
!-------------------------------------------------------------------------------
 
82
! 2-dim display
 
83
!-------------------------------------------------------------------------------
 
84
 
 
85
  LOAD {P1}
 
86
  WRITE/OUT "object = blue"
 
87
  CLEAR/CHAN OVERLAY
 
88
  PLOTPAR3 = PLOTPAR1+{TMP1}*({TMP2(1)}-1)
 
89
  
 
90
  COPY/DK {OUT_D}.tbl NOBJ/I/1/1 NOBJ
 
91
  IF {NOBJ} .GT. 0 THEN 
 
92
    DO I = 1 {NOBJ}
 
93
      PLOTPAR2 = {{OUT_D},:Obj_Strt,{I}}
 
94
      PLOTPAR4 = {{OUT_D},:Obj_End,{I}}
 
95
      SET/MIDAS OUTPUT=LOGONLY
 
96
      DRAW/RECTA {PLOTPAR1},{PLOTPAR2},{PLOTPAR3},{PLOTPAR4} F ? 5 ? 
 
97
      SET/MIDAS OUTPUT=ON
 
98
    ENDDO
 
99
  ENDIF 
 
100
 
 
101
  write/keyw cont/c/1/1 y
 
102
  if m$existk("alltutos") .eq. 1 then
 
103
     if alltutos .eq. 1 goto cont_check
 
104
  endif
 
105
 
 
106
  inquire/keyw cont "Press return to plot sky, n to stop"
 
107
 
 
108
cont_check:
 
109
  IF cont .eq. "y" then
 
110
    WRITE/OUT "sky = green "
 
111
    COPY/DK {OUT_D}.tbl NSKY/I/1/1 NSKY
 
112
    IF NSKY .GT. 0 THEN 
 
113
      DO I = 1 {NSKY}
 
114
        PLOTPAR2 = {{OUT_D},:Sky_Strt,{I}}
 
115
        PLOTPAR4 = {{OUT_D},:Sky_End,{I}}
 
116
        SET/MIDAS OUTPUT=LOGONLY
 
117
        DRAW/RECTA {PLOTPAR1},{PLOTPAR2},{PLOTPAR3},{PLOTPAR4} F ? 4 ? 
 
118
        SET/MIDAS OUTPUT=ON
 
119
      ENDDO
 
120
    ENDIF       
 
121
  ELSE 
 
122
    WRITE/KEYW cont/c/1/1 y
 
123
  ENDIF
 
124
ENDIF
 
125
 
 
126
IF INPUTI(3) .ge. 2 THEN
 
127
 
 
128
!-------------------------------------------------------------------------------
 
129
! Graphical display
 
130
!-------------------------------------------------------------------------------
 
131
 
 
132
  WRITE/OUT "Now computing 1-dimensional frames"
 
133
  TMP3 = SCAN-{INPUTI(2)}/2
 
134
  TMP4 = SCAN+{INPUTI(2)}/2
 
135
  AVER/COLUMN MIDTMPC = {P1} {TMP3},{TMP4}
 
136
  TMP3 = PLOTPAR1+{TMP1}*{INPUTI(1)}
 
137
  TMP4 = PLOTPAR1+{TMP1}*({INPUTI(1)}+{INPUTI(2)})
 
138
  AVER/COLUMN MIDTMPS = {P1} {TMP3},{TMP4}
 
139
  TMP3 = PLOTPAR1+{TMP1}*({TMP2(1)}-{INPUTI(1)}-{INPUTI(2)})
 
140
  TMP4 = PLOTPAR1+{TMP1}*({TMP2(1)}-{INPUTI(1)})
 
141
  AVER/COLUMN MIDTMPE = {P1} {TMP3},{TMP4}
 
142
  write/key OUT_D "{p3}"
 
143
  SET/GRAP COLOUR=1 LTYPE=1
 
144
  PLOT MIDTMPC
 
145
  SET/GRAP COLOUR=1 LTYPE=2
 
146
  OVER MIDTMPS
 
147
  OVER MIDTMPE
 
148
  SET/GRAP COLOUR=4 LTYPE=1
 
149
  COPY/DK {OUT_D}.tbl NOBJ/I/1/1 NOBJ
 
150
  DO I = 1 NOBJ
 
151
    PLOTPAR1 = {PLRGRAP(5)}*0.5+{PLRGRAP(6)}*0.5
 
152
    PLOTPAR2 = {{OUT_D},:Obj_Strt,{I}}
 
153
    PLOTPAR4 = {{OUT_D},:Obj_End,{I}}
 
154
    OVERPLOT/LINE 1 {PLOTPAR2},{PLRGRAP(5)} {PLOTPAR2},{PLRGRAP(6)}
 
155
    OVERPLOT/LINE 1 {PLOTPAR4},{PLRGRAP(5)} {PLOTPAR4},{PLRGRAP(6)}
 
156
    OVERPLOT/LINE 1 {PLOTPAR2},{PLOTPAR1} {PLOTPAR4},{PLOTPAR1}
 
157
  ENDDO
 
158
  SET/GRAP COLOUR=3
 
159
  COPY/DK {OUT_D}.tbl NSKY/I/1/1 NSKY
 
160
  DO I = 1 NSKY
 
161
    PLOTPAR1 = {PLRGRAP(5)}*0.5+{PLRGRAP(6)}*0.5
 
162
    PLOTPAR2 = {{OUT_D},:Sky_Strt,{I}}
 
163
    PLOTPAR4 = {{OUT_D},:Sky_End,{I}}
 
164
    OVERPLOT/LINE 1 {PLOTPAR2},{PLRGRAP(5)} {PLOTPAR2},{PLRGRAP(6)}
 
165
    OVERPLOT/LINE 1 {PLOTPAR4},{PLRGRAP(5)} {PLOTPAR4},{PLRGRAP(6)}
 
166
    OVERPLOT/LINE 1 {PLOTPAR2},{PLOTPAR1} {PLOTPAR4},{PLOTPAR1}
 
167
  ENDDO
 
168
  SET/GRAP COLOUR=1
 
169
ENDIF
 
170
   
 
171
 
 
172
!-------------------------------------------------------------------------------
 
173
! Possibility to change objects' and sky positions
 
174
!-------------------------------------------------------------------------------
 
175
 
 
176
ask:
 
177
  write/key cont/c/1/1 y
 
178
  if m$existk("alltutos") .eq. 1 then
 
179
     if alltutos .eq. 1 goto end
 
180
  endif
 
181
 
 
182
  INQUIRE/KEYW cont "Are you satisfied with this? Default = y"
 
183
  IF cont .eq. "y" GOTO end 
 
184
 
 
185
decide:
 
186
  WRITE/KEYW cont/c/1/1 y
 
187
  WRITE/OUT "Do you want to ..."
 
188
  WRITE/OUT "... delete an object?    --> 1"
 
189
  WRITE/OUT "... add an object?       --> 2"
 
190
  WRITE/OUT "... delete a sky region? --> 3"
 
191
  WRITE/OUT "... add a sky region?    --> 4"
 
192
  WRITE/OUT "... change an object   ? --> 5"
 
193
  WRITE/OUT "... change a sky region? --> 6"
 
194
  WRITE/OUT "... have a closer look?  --> 7"
 
195
  WRITE/OUT "... stop?                --> 8"
 
196
  inquire/keyw path/i/1/1 "Enter choice: "
 
197
  IF path(1) .eq. 8 GOTO end
 
198
 
 
199
!-------------------------------------------------------------------------------
 
200
! Plot only slitlet to deal with
 
201
!-------------------------------------------------------------------------------
 
202
 
 
203
INQUIRE/KEYW J "Enter number of slitlet"
 
204
path(2) = {J}
 
205
 
 
206
 
 
207
IF {INPUTI(3)} .le. 1 THEN
 
208
  WRITE/OUT "Now computing 1-dimensional frames"
 
209
  DISPLAY/LONG
 
210
  TMP3 = SCAN-{INPUTI(2)}/2
 
211
  TMP4 = SCAN+{INPUTI(2)}/2
 
212
  AVER/COLUMN MIDTMPC = {P1} {TMP3},{TMP4}
 
213
  TMP3 = PLOTPAR1+{TMP1}*{INPUTI(1)}
 
214
  TMP4 = PLOTPAR1+{TMP1}*({INPUTI(1)}+{INPUTI(2)})
 
215
  AVER/COLUMN MIDTMPS = {P1} {TMP3},{TMP4}
 
216
  TMP3 = PLOTPAR1+{TMP1}*({TMP2(1)}-{INPUTI(1)}-{INPUTI(2)})
 
217
  TMP4 = PLOTPAR1+{TMP1}*({TMP2(1)}-{INPUTI(1)})
 
218
  AVER/COLUMN MIDTMPE = {P1} {TMP3},{TMP4}
 
219
  WRITE/KEYW INPUTI/I/3/3 2
 
220
ENDIF
 
221
plotslit:
 
222
  TMP3 = {{IN_B},:ystart,@{J}}
 
223
  TMP4 = {{IN_B},:yend,@{J}}
 
224
  PLOT MIDTMPC ? {TMP3},{TMP4}
 
225
  SET/GRAP COLOUR=1 LTYPE=2
 
226
  OVER MIDTMPS
 
227
  OVER MIDTMPE
 
228
 
 
229
!-------------------------------------------------------------------------------
 
230
! Mark objects
 
231
!-------------------------------------------------------------------------------
 
232
 
 
233
  SET/GRAP COLOUR=4 LTYPE=1
 
234
  COPY/DK {OUT_D}.tbl NOBJ/I/1/1 NOBJ
 
235
  DO I = 1 {NOBJ}
 
236
    SELECT = {{OUT_D},:Obj_Slit,{I}}
 
237
    IF SELECT .EQ. PATH(2) THEN
 
238
      PLOTPAR1 = {PLRGRAP(5)}*0.5+{PLRGRAP(6)}*0.5
 
239
      PLOTPAR2 = {{OUT_D},:Obj_Strt,{I}}
 
240
      PLOTPAR4 = {{OUT_D},:Obj_End,{I}}
 
241
      OVERPLOT/LINE 1 {PLOTPAR2},{PLRGRAP(5)} {PLOTPAR2},{PLRGRAP(6)}
 
242
      OVERPLOT/LINE 1 {PLOTPAR4},{PLRGRAP(5)} {PLOTPAR4},{PLRGRAP(6)}
 
243
      OVERPLOT/LINE 1 {PLOTPAR2},{PLOTPAR1} {PLOTPAR4},{PLOTPAR1}
 
244
      WRITE/KEYW FOUND/I/1/1 1
 
245
    ENDIF
 
246
  ENDDO
 
247
 
 
248
!-------------------------------------------------------------------------------
 
249
! Mark sky
 
250
!-------------------------------------------------------------------------------
 
251
 
 
252
  SET/GRAP COLOUR=3
 
253
  COPY/DK {OUT_D}.tbl NSKY/I/1/1 NSKY
 
254
  DO I = 1 {NSKY}
 
255
    SELECT = {{OUT_D},:Sky_Slit,{I}}
 
256
    IF SELECT .EQ. PATH(2) THEN
 
257
      PLOTPAR1 = {PLRGRAP(5)}*0.5+{PLRGRAP(6)}*0.5
 
258
      PLOTPAR2 = {{OUT_D},:Sky_Strt,{I}}
 
259
      PLOTPAR4 = {{OUT_D},:Sky_End,{I}}
 
260
      OVERPLOT/LINE 1 {PLOTPAR2},{PLRGRAP(5)} {PLOTPAR2},{PLRGRAP(6)}
 
261
      OVERPLOT/LINE 1 {PLOTPAR4},{PLRGRAP(5)} {PLOTPAR4},{PLRGRAP(6)}
 
262
      OVERPLOT/LINE 1 {PLOTPAR2},{PLOTPAR1} {PLOTPAR4},{PLOTPAR1}
 
263
      WRITE/KEYW FOUND/I/1/1 1
 
264
    ENDIF
 
265
  ENDDO
 
266
  SET/GRAP COLOUR=1
 
267
 
 
268
  IF FOUND .eq. 0 THEN
 
269
    WRITE/OUT "                  *** No results for this slitlet ***"
 
270
  ELSE
 
271
    WRITE/KEYW FOUND/I/1/1 0.
 
272
  ENDIF
 
273
 
 
274
  IF path(1) .eq. 1 THEN
 
275
    GOTO delobj
 
276
  ELSEIF path(1) .eq. 2 THEN
 
277
    GOTO add
 
278
  ELSEIF path(1) .eq. 3 THEN
 
279
    GOTO delsky
 
280
  ELSEIF path(1) .eq. 4 THEN
 
281
    GOTO add
 
282
  ELSEIF path(1) .eq. 5 THEN
 
283
    GOTO change
 
284
  ELSEIF path(1) .eq. 6 THEN
 
285
    GOTO change
 
286
  ELSEIF path(1) .eq. 7 THEN
 
287
    GOTO decide
 
288
  ELSEIF path(1) .gt. 8 THEN
 
289
    GOTO decide
 
290
ENDIF
 
291
 
 
292
delobj:
 
293
!-------------------------------------------------------------------------------
 
294
! Delete object
 
295
!-------------------------------------------------------------------------------
 
296
 
 
297
  WRITE/OUT "Click on object you want to delete"
 
298
  GET/GCURSOR
 
299
  WRITE/KEYW POSR/R/1/1 {OUTPUTR(5)}
 
300
  write/keyw OUT_A/c/1/60 {OUT_D(1:60)}
 
301
  RUN STD_EXE:CHANGEDEF
 
302
  WRITE/KEYW cont/c/1/1 y
 
303
  WRITE/KEYW path/i/1/1 9
 
304
  WRITE/OUT "Results..."
 
305
  GOTO plotslit
 
306
 
 
307
add:
 
308
!-------------------------------------------------------------------------------
 
309
! Define new object or sky
 
310
!-------------------------------------------------------------------------------
 
311
 
 
312
  IF path(1) .eq. 2 THEN
 
313
    WRITE/OUT "Click on object you want to add"
 
314
  ELSEIF path(1) .eq. 4 THEN
 
315
    WRITE/OUT "Click on sky you want to add"
 
316
  ENDIF
 
317
  WRITE/OUT "First left/lower limit"
 
318
  GET/GCURSOR
 
319
  WRITE/KEYW POSR/R/1/1 {OUTPUTR(5)}
 
320
  WRITE/OUT "Now right/upper limit"
 
321
  GET/GCURSOR
 
322
  WRITE/KEYW POSR/R/2/2 {OUTPUTR(5)}
 
323
!-------------------------------------------------------------------------------
 
324
! Check new object resp. sky
 
325
!-------------------------------------------------------------------------------
 
326
  SET/GRAP COLOUR=2
 
327
  OVERPLOT/LINE 1 {POSR(1)},{PLRGRAP(5)} {POSR(1)},{PLRGRAP(6)}
 
328
  OVERPLOT/LINE 1 {POSR(2)},{PLRGRAP(5)} {POSR(2)},{PLRGRAP(6)}
 
329
  SET/GRAP COLOUR=1
 
330
  INQUIRE/KEYW cont "Are you satisfied with this? Default = y"
 
331
  IF cont .eq. "y" then
 
332
    write/keyw OUT_A/c/1/60 {OUT_D(1:60)}
 
333
    RUN STD_EXE:CHANGEDEF
 
334
  ELSE 
 
335
    WRITE/KEYW cont/c/1/1 y
 
336
    GOTO add
 
337
  ENDIF
 
338
  WRITE/KEYW path/i/1/1 9
 
339
  WRITE/OUT "Results..."
 
340
  GOTO plotslit
 
341
 
 
342
delsky:
 
343
!-------------------------------------------------------------------------------
 
344
! Delete sky
 
345
!-------------------------------------------------------------------------------
 
346
 
 
347
  WRITE/OUT "Click on sky you want to delete"
 
348
  GET/GCURSOR
 
349
  WRITE/KEYW POSR/R/1/1 {OUTPUTR(5)}
 
350
  write/keyw OUT_A/c/1/60 {OUT_D(1:60)}
 
351
  RUN STD_EXE:CHANGEDEF
 
352
  WRITE/KEYW cont/c/1/1 y
 
353
  WRITE/KEYW path/i/1/1 9
 
354
  WRITE/OUT "Results..."
 
355
  GOTO plotslit
 
356
 
 
357
change:
 
358
!-------------------------------------------------------------------------------
 
359
! Change object/sky
 
360
!-------------------------------------------------------------------------------
 
361
 
 
362
  WRITE/KEYW cont/c/1/1 y
 
363
  IF path(1) .eq. 5 THEN
 
364
    WRITE/OUT "Click on object you want to change"
 
365
    WRITE/OUT "First old object"
 
366
  ELSEIF path(1) .eq. 6 THEN
 
367
    WRITE/OUT "Click on sky you want to change"
 
368
    WRITE/OUT "First old sky"
 
369
  ENDIF
 
370
  GET/GCURSOR
 
371
  WRITE/KEYW POSR/R/3/3 {OUTPUTR(5)}
 
372
  INQUIRE/KEYW cont "Do you want to change left/lower limit? Default = y"
 
373
  IF cont .eq. "n" then
 
374
    WRITE/KEYW POSR/R/1/1 -9999.9
 
375
  ELSE
 
376
    GET/GCURSOR
 
377
    WRITE/KEYW POSR/R/1/1 {OUTPUTR(5)}
 
378
  ENDIF
 
379
  WRITE/KEYW cont/c/1/1 y
 
380
  INQUIRE/KEYW cont "Do you want to change right/upper limit? Default = y"
 
381
  IF cont .eq. "n" then
 
382
    WRITE/KEYW POSR/R/2/2 -9999.9
 
383
  ELSE
 
384
    GET/GCURSOR
 
385
    WRITE/KEYW POSR/R/2/2 {OUTPUTR(5)}
 
386
  ENDIF
 
387
  WRITE/KEYW cont/c/1/1 y
 
388
!-------------------------------------------------------------------------------
 
389
! Check new object/sky
 
390
!-------------------------------------------------------------------------------
 
391
  SET/GRAP COLOUR=2
 
392
  OVERPLOT/LINE 1 {POSR(1)},{PLRGRAP(5)} {POSR(1)},{PLRGRAP(6)}
 
393
  OVERPLOT/LINE 1 {POSR(2)},{PLRGRAP(5)} {POSR(2)},{PLRGRAP(6)}
 
394
  SET/GRAP COLOUR=1
 
395
  INQUIRE/KEYW cont "Are you satisfied with this? Default = y"
 
396
  IF cont .eq. "y" then
 
397
    write/keyw OUT_A/c/1/60 {OUT_D(1:60)}
 
398
    RUN STD_EXE:CHANGEDEF
 
399
  ELSE 
 
400
    WRITE/KEYW cont/c/1/1 y
 
401
    GOTO change
 
402
  ENDIF
 
403
  WRITE/KEYW path/i/1/1 9
 
404
  WRITE/OUT "Results..."
 
405
  GOTO plotslit
 
406
 
 
407
end:
 
408
dele MIDTMPS no
 
409
dele MIDTMPC no
 
410
dele MIDTMPE no
 
411
 
 
412
 
 
413
 
 
414
 
 
415