← Back to branch summary

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

« back to all changes in this revision

Viewing changes to prim/display/libsrc/dto.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:
prim/display/libsrc/dto.for
 
1
C @(#)dto.for   19.1 (ES0-DMD) 02/25/03 13:59:58
 
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 Massachusetss Ave, Cambridge, 
 
18
C MA 02139, USA.
 
19
C
 
20
C Corresponding 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+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
31
C
 
32
C
 
33
C.IDENTIFICATION:
 
34
C  subroutine DTO               version 1.00   840614
 
35
C  R.M. van Hees                ESO - Garching
 
36
C
 
37
C.KEYWORDS:
 
38
C  High level image display interfaces
 
39
C
 
40
C.PURPOSE:
 
41
C  Takes care of opening and closing of display devices
 
42
C
 
43
C.ALGORITHM:
 
44
C  updates display keywords and display common blocks
 
45
C  calls high level C display interfaces 
 
46
C
 
47
C.COMMENTS
 
48
C  holds DTOPEN, DTCLOS, DTGICH and DTPICH
 
49
C
 
50
C.VERSIONS
 
51
C  1.00       Taken from DAZSUBS.FOR, author K.Banse
 
52
C--------------------------------------------------------------------------
 
53
C
 
54
C
 
55
C ++++++++++++++++++++++++++++++
 
56
C.IDENTIFIER  DTOPEN
 
57
C.PURPOSE
 
58
C  connect to IDI device + save info display common blocks IDIDEV & IDIMEM
 
59
C
 
60
C.INPUT/OUTPUT
 
61
C  call as   DTOPEN(FLAG,STAT)
 
62
C
 
63
C  input par:
 
64
C     FLAG:        integer      1 for display window
 
65
C                               2 for graphics window
 
66
C                               3 for zoom window (display)
 
67
C  output par:
 
68
C  STAT:        integer         return status: 
 
69
C                               0   if o.k. - no change in window size
 
70
C                               1   if o.k. - yes, a change in window size
 
71
C                              -1   if error
 
72
C ------------------------------
 
73
C
 
74
      SUBROUTINE DTOPEN(FLAG,STAT)
 
75
C
 
76
      IMPLICIT NONE
 
77
C
 
78
      INTEGER FLAG,STAT
 
79
      INTEGER IAV
 
80
      INTEGER UNIT(1),NULLO
 
81
C
 
82
      INCLUDE  'MID_INCLUDE:IDIDEV.INC'
 
83
      INCLUDE  'MID_INCLUDE:IDIMEM.INC'
 
84
C 
 
85
      CALL DAZOPN(FLAG)
 
86
C 
 
87
      CALL STKRDI('IDIDEV',1,26,IAV,DZDEV,UNIT,NULLO,STAT)
 
88
      CALL STKRDI('IDIMEMI',1,17,IAV,DZMEMI,UNIT,NULLO,STAT)
 
89
      RETURN
 
90
C 
 
91
      END
 
92
 
 
93
C
 
94
C ++++++++++++++++++++++++++++++
 
95
C.IDENTIFIER  DTCLOS
 
96
C.PURPOSE
 
97
C  close display & save display common blocks
 
98
C
 
99
C.INPUT/OUTPUT
 
100
C  call as   DTCLOS(DISPNO)
 
101
C
 
102
C  input par:
 
103
C  DISPNO:      integer         display number
 
104
C
 
105
C ------------------------------
 
106
C
 
107
      SUBROUTINE DTCLOS(DISPNO)
 
108
C 
 
109
      IMPLICIT NONE
 
110
C
 
111
      INTEGER DISPNO,STAT
 
112
      INTEGER UNIT(1)
 
113
C
 
114
      INCLUDE  'MID_INCLUDE:IDIDEV.INC'
 
115
C 
 
116
      CALL DAZCLO(DISPNO)
 
117
C
 
118
      CALL STKWRI('IDIDEV',DZDEV,1,26,UNIT,STAT)
 
119
      RETURN
 
120
C 
 
121
      END
 
122
 
 
123
C
 
124
C ++++++++++++++++++++++++++++++
 
125
C.IDENTIFIER  DTGICH
 
126
C.PURPOSE
 
127
C  return info about given channel in the image display
 
128
C
 
129
C.INPUT/OUTPUT
 
130
C  call as   DTGICH(DSPLAY,CHANL,NAME,RBUF,STAT)
 
131
C
 
132
C  input par:
 
133
C  DSPLAY:      integer         image display device no.
 
134
C  CHANL:       integer         image display channel no. (0,1,...)
 
135
C 
 
136
C  output par:
 
137
C  NAME:        char. string    name of frame currently loaded into channel
 
138
C  RBUF:        real array      real info related to channel, 
 
139
C                               (8 elements long)
 
140
C  STAT:        integer         return status: 
 
141
C                               0 = o.k.
 
142
C                               1 = nothing loaded into channel
 
143
C
 
144
C ------------------------------
 
145
C
 
146
      SUBROUTINE DTGICH(DSPLAY,CHANL,NAME,RBUF,STAT)
 
147
C
 
148
      IMPLICIT NONE
 
149
C
 
150
      INTEGER IAV,DSPLAY,CHANL,STAT
 
151
      INTEGER RLEN,ILEN,CLEN
 
152
      INTEGER UNIT(1),NULLO
 
153
C
 
154
      CHARACTER*(*) NAME
 
155
      CHARACTER WORK*60
 
156
C 
 
157
      REAL  RBUF(*)
 
158
C
 
159
      INCLUDE  'MID_INCLUDE:IDIDEV.INC'
 
160
      INCLUDE  'MID_INCLUDE:IDIMEM.INC'
 
161
C 
 
162
      DATA  RLEN /8/                        !float length per channel
 
163
      DATA  CLEN /60/                       !char. length per channel
 
164
      DATA  ILEN /17/                       !integer length per channel
 
165
C
 
166
      CALL DAZGII(CHANL)
 
167
C 
 
168
C  move from keywords to COMMON + Parameter arrays
 
169
C 
 
170
      CALL STKRDC('IDIMEMC',1,1,CLEN,IAV,WORK,UNIT,NULLO,STAT)
 
171
      CALL STKRDI('IDIMEMI',1,ILEN,IAV,DZMEMI,UNIT,NULLO,STAT)
 
172
      CALL STKRDR('IDIMEMR',1,RLEN,IAV,RBUF,UNIT,NULLO,STAT)
 
173
C 
 
174
      NAME(1:) = WORK(1:CLEN)//' '
 
175
      IF (NAME(1:1).EQ.' ') THEN
 
176
         STAT = 1                          !indicate, that there is no image
 
177
      ELSE
 
178
         STAT = 0
 
179
      ENDIF
 
180
C 
 
181
      RETURN
 
182
      END
 
183
 
 
184
C
 
185
C ++++++++++++++++++++++++++++++
 
186
C.IDENTIFIER  DTPICH
 
187
C.PURPOSE
 
188
C  store info about given channel in the relevant keywords
 
189
C
 
190
C.INPUT/OUTPUT
 
191
C  call as   DTPICH(DSPLAY,CHANL,NAME,RBUF,STAT)
 
192
C
 
193
C  input par:
 
194
C  DSPLAY:      integer         image display device no.
 
195
C  CHANL:       integer         image display channel no. (0,1,...)
 
196
C  NAME:        char. string    name of frame currently loaded into channel
 
197
C  RBUF:        real array      real info related to channel, 
 
198
C                               (8 elements long)
 
199
C
 
200
C  output par:
 
201
C  STAT:        integer         return status: 0 = o.k., 
 
202
C                                              else something wrong...
 
203
C
 
204
C ------------------------------
 
205
C
 
206
      SUBROUTINE DTPICH(DSPLAY,CHANL,NAME,RBUF,STAT)
 
207
C
 
208
      IMPLICIT NONE
 
209
C
 
210
      INTEGER DSPLAY,CHANL,STAT
 
211
      INTEGER RLEN,ILEN,CLEN
 
212
      INTEGER UNIT(1)
 
213
C
 
214
      CHARACTER*(*) NAME
 
215
      CHARACTER WORK*60
 
216
C
 
217
      REAL  RBUF(*)
 
218
C
 
219
      INCLUDE  'MID_INCLUDE:IDIDEV.INC'
 
220
      INCLUDE  'MID_INCLUDE:IDIMEM.INC'
 
221
C
 
222
      DATA  RLEN /8/                        !float length per channel
 
223
      DATA  CLEN /60/                       !char. length per channel
 
224
      DATA  ILEN /17/                       !integer length per channel
 
225
C
 
226
C  store name of loaded frame 
 
227
      WORK(1:) = NAME(1:)//' '
 
228
      CALL STKWRC('IDIMEMC',1,WORK,1,CLEN,UNIT,STAT) 
 
229
      CALL STKWRI('IDIMEMI',DZMEMI,1,ILEN,UNIT,STAT)
 
230
      CALL STKWRR('IDIMEMR',RBUF,1,RLEN,UNIT,STAT)
 
231
C
 
232
      CALL DAZPII(CHANL)
 
233
C 
 
234
      STAT   = 0
 
235
      RETURN
 
236
      END