← Back to branch summary

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

« back to all changes in this revision

Viewing changes to libsrc/ftoc-new/ystd.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:
libsrc/ftoc-new/ystd.for
 
1
C===========================================================================
 
2
C Copyright (C) 1995-2009 European Southern Observatory (ESO)
 
3
C
 
4
C This program is free software; you can redistribute it and/or 
 
5
C modify it under the terms of the GNU General Public License as 
 
6
C published by the Free Software Foundation; either version 2 of 
 
7
C the License, or (at your option) any later version.
 
8
C
 
9
C This program is distributed in the hope that it will be useful,
 
10
C but WITHOUT ANY WARRANTY; without even the implied warranty of
 
11
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
12
C GNU General Public License for more details.
 
13
C
 
14
C You should have received a copy of the GNU General Public 
 
15
C License along with this program; if not, write to the Free 
 
16
C Software Foundation, Inc., 675 Massachusetts Ave, Cambridge, 
 
17
C MA 02139, USA.
 
18
C
 
19
C Correspondence concerning ESO-MIDAS should be addressed as follows:
 
20
C       Internet e-mail: midas@eso.org
 
21
C       Postal address: European Southern Observatory
 
22
C                       Data Management Division 
 
23
C                       Karl-Schwarzschild-Strasse 2
 
24
C                       D 85748 Garching bei Muenchen 
 
25
C                       GERMANY
 
26
C===========================================================================
 
27
 
 
28
C ++++++++++++++++++++++++  ystd.for +++++++++++++++++++++++++++++++++++++++
 
29
C .LANGUAGE Fortran 77
 
30
C .IDENTIFICATION Module ystd.for
 
31
C .COMMENTS
 
32
C Module contains layer between the keyword related FORTRAN STxxxx interfaces
 
33
C and the SC_interfaces written in (hopefully independent) C
 
34
C .AUTHOR         K. Banse        ESO - Garching
 
35
C .KEYWORDS       standard interfaces.
 
36
C .ENVIRONMENT    FORTRAN and C standards
 
37
C .VERSION  [1.00] 871207:  
 
38
C 
 
39
C 090323        last modif
 
40
C -----------------------------------------------------------------------------
 
41
C
 
42
      SUBROUTINE STDRDI(NO,DESCR,FELEM,MAXVALS,ACTVALS,VALUES,DUNIT,
 
43
     +                  DNULL,STATUS)
 
44
C
 
45
      IMPLICIT NONE
 
46
C
 
47
      INTEGER     NO
 
48
      CHARACTER*(*)   DESCR        
 
49
      INTEGER     FELEM, MAXVALS, ACTVALS
 
50
      INTEGER     VALUES(*)
 
51
      INTEGER     DUNIT, DNULL
 
52
      INTEGER    STATUS
 
53
C 
 
54
      DUNIT = 0
 
55
      DNULL = 0
 
56
C
 
57
      CALL STSTR(1,DESCR)                          !STRIPPED_STRING
 
58
C 
 
59
      CALL STD1(NO,FELEM,MAXVALS,ACTVALS,VALUES,STATUS)
 
60
C
 
61
      RETURN
 
62
      END
 
63
C
 
64
 
 
65
 
 
66
      SUBROUTINE STDRDL(NO,DESCR,FELEM,MAXVALS,ACTVALS,VALUES,DUNIT,
 
67
     +                  DNULL,STATUS)
 
68
C
 
69
      IMPLICIT NONE
 
70
C
 
71
      INTEGER     NO
 
72
      CHARACTER*(*)   DESCR        
 
73
      INTEGER     FELEM, MAXVALS, ACTVALS
 
74
      INTEGER     VALUES(*)
 
75
      INTEGER     DUNIT, DNULL
 
76
      INTEGER    STATUS
 
77
C 
 
78
      DUNIT = 0
 
79
      DNULL = 0
 
80
C
 
81
      CALL STSTR(1,DESCR)                          !STRIPPED_STRING
 
82
C
 
83
      CALL STD2(NO,FELEM,MAXVALS,ACTVALS,VALUES,STATUS)
 
84
C
 
85
      RETURN
 
86
      END
 
87
C
 
88
C 
 
89
      SUBROUTINE STDRDR(NO,DESCR,FELEM,MAXVALS,ACTVALS,VALUES,DUNIT,
 
90
     +                  DNULL,STATUS)
 
91
C
 
92
      IMPLICIT NONE
 
93
C
 
94
      INTEGER     NO
 
95
      CHARACTER*(*)   DESCR        
 
96
      INTEGER     FELEM, MAXVALS, ACTVALS
 
97
      REAL     VALUES(*)
 
98
      INTEGER     DUNIT, DNULL
 
99
      INTEGER    STATUS
 
100
C 
 
101
      DUNIT = 0
 
102
      DNULL = 0
 
103
C 
 
104
      CALL STSTR(1,DESCR)                          !STRIPPED_STRING
 
105
C
 
106
      CALL STD3(NO,FELEM,MAXVALS,ACTVALS,VALUES,STATUS)
 
107
C
 
108
      RETURN
 
109
      END
 
110
C
 
111
C 
 
112
      SUBROUTINE STDRDD(NO,DESCR,FELEM,MAXVALS,ACTVALS,VALUES,DUNIT,
 
113
     +                  DNULL,STATUS)
 
114
C
 
115
      IMPLICIT NONE
 
116
C
 
117
      INTEGER     NO
 
118
      CHARACTER*(*)   DESCR        
 
119
      INTEGER     FELEM, MAXVALS, ACTVALS
 
120
      DOUBLE PRECISION     VALUES(*)
 
121
      INTEGER     DUNIT, DNULL
 
122
      INTEGER    STATUS
 
123
C 
 
124
      DUNIT = 0
 
125
      DNULL = 0
 
126
C 
 
127
      CALL STSTR(1,DESCR)                          !STRIPPED_STRING
 
128
C
 
129
      CALL STD4(NO,FELEM,MAXVALS,ACTVALS,VALUES,STATUS)
 
130
C
 
131
      RETURN
 
132
      END
 
133
C 
 
134
C
 
135
      SUBROUTINE STDRDS(NO,DESCR,FELEM,MAXVALS,ACTVALS,VALUES,DUNIT,
 
136
     +                  DNULL,STATUS)
 
137
C
 
138
      IMPLICIT NONE
 
139
C
 
140
      INTEGER     NO
 
141
      CHARACTER*(*)   DESCR        
 
142
      INTEGER     FELEM, MAXVALS, ACTVALS
 
143
      INTEGER*8     VALUES(*)
 
144
      INTEGER     DUNIT, DNULL
 
145
      INTEGER    STATUS
 
146
C 
 
147
      DUNIT = 0
 
148
      DNULL = 0
 
149
C 
 
150
      CALL STSTR(1,DESCR)                          !STRIPPED_STRING
 
151
C
 
152
      CALL STD4a(NO,FELEM,MAXVALS,ACTVALS,VALUES,STATUS)
 
153
C
 
154
      RETURN
 
155
      END
 
156
C 
 
157
C
 
158
      SUBROUTINE STDRDC(NO,DESCR,NOELM,FELEM,MAXVALS,ACTVALS,VALUES,
 
159
     +                  DUNIT,DNULL,STATUS)
 
160
C
 
161
      IMPLICIT NONE
 
162
C
 
163
      INTEGER     NO
 
164
      CHARACTER*(*)   DESCR, VALUES
 
165
      INTEGER     NOELM, FELEM, MAXVALS, ACTVALS
 
166
      INTEGER     DUNIT, DNULL
 
167
      INTEGER    STATUS
 
168
C 
 
169
      DUNIT = 0
 
170
      DNULL = 0
 
171
C
 
172
      CALL STSTR(1,DESCR)                          !STRIPPED_STRING
 
173
      CALL STLOC(1,1,VALUES)                       !blanked CHAR_LOC
 
174
C
 
175
      CALL STD5(NO,NOELM,FELEM,MAXVALS,ACTVALS,STATUS)
 
176
C
 
177
      RETURN
 
178
      END
 
179
C 
 
180
C
 
181
      SUBROUTINE STDRDH(NO,DESCR,FELEM,MAXVALS,ACTVALS,VALUES,
 
182
     +                  TOTAL,STATUS)
 
183
C
 
184
      IMPLICIT NONE
 
185
C
 
186
      INTEGER     NO
 
187
      CHARACTER*(*)   DESCR, VALUES
 
188
      INTEGER     TOTAL, FELEM, MAXVALS, ACTVALS
 
189
      INTEGER    STATUS
 
190
C 
 
191
      CALL STSTR(1,DESCR)                          !STRIPPED_STRING
 
192
      CALL STLOC(1,1,VALUES)                       !blanked CHAR_LOC
 
193
C
 
194
      CALL STD6(NO,FELEM,MAXVALS,ACTVALS,TOTAL,STATUS)
 
195
C
 
196
      RETURN
 
197
      END
 
198
C 
 
199
 
 
200
      SUBROUTINE STDFND(NO,DESCR,CTYPE,NOELEM,BYTELEM,STATUS)
 
201
C 
 
202
      IMPLICIT NONE
 
203
C
 
204
      INTEGER     NO
 
205
      CHARACTER*(*)   DESCR, CTYPE
 
206
      INTEGER     NOELEM, BYTELEM
 
207
      INTEGER     STATUS
 
208
C
 
209
      CALL STSTR(1,DESCR)                          !STRIPPED_STRING
 
210
      CALL STLOC(1,1,CTYPE)                        !blanked CHAR_LOC
 
211
C
 
212
      CALL STD7(NO,NOELEM,BYTELEM,STATUS)
 
213
C
 
214
      RETURN
 
215
      END
 
216
C
 
217
C 
 
218
      SUBROUTINE STDINF(NO,NPOS,FIELD,BUF,NUMBUF,STATUS)
 
219
C 
 
220
      IMPLICIT NONE
 
221
C
 
222
      INTEGER     NO
 
223
      CHARACTER*(*)   BUF
 
224
      INTEGER     NPOS, FIELD, NUMBUF
 
225
      INTEGER     STATUS
 
226
C
 
227
      CALL STLOC(1,1,BUF)                          !blanked CHAR_LOC
 
228
C
 
229
      CALL STD8(NO,NPOS,FIELD,NUMBUF,STATUS)
 
230
C
 
231
      RETURN
 
232
      END
 
233
C
 
234
C
 
235
      SUBROUTINE STDRDX(NO,FLAG,DESCR,CTYPE,BYTEL,NOEL,HNC,STATUS)
 
236
C
 
237
      IMPLICIT NONE
 
238
C
 
239
      INTEGER     NO
 
240
      CHARACTER*(*)   DESCR, CTYPE
 
241
      INTEGER     FLAG, BYTEL, NOEL, HNC
 
242
      INTEGER     STATUS
 
243
C
 
244
      CALL STLOC(1,1,DESCR)                          !blanked CHAR_LOC
 
245
      CALL STLOC(2,1,CTYPE)                          !blanked CHAR_LOC
 
246
C
 
247
      CALL STD9(NO,FLAG,BYTEL,NOEL,HNC,STATUS)
 
248
C
 
249
      RETURN
 
250
      END
 
251
 
 
252
 
 
253
      SUBROUTINE STDWRC(NO,DESCR,NOELM,VALUES,FELEM,MAXVALS,
 
254
     +                  DUNIT,STATUS)
 
255
C
 
256
      IMPLICIT NONE
 
257
C
 
258
      INTEGER     NO
 
259
      CHARACTER*(*)   DESCR, VALUES
 
260
      INTEGER     NOELM, FELEM, MAXVALS
 
261
      INTEGER     DUNIT
 
262
      INTEGER     STATUS
 
263
C
 
264
      CALL STSTR(1,DESCR)                          !STRIPPED_STRING
 
265
      CALL STLOC(1,0,VALUES)                       !untouched CHAR_LOC
 
266
C 
 
267
      CALL STD10(NO,NOELM,FELEM,MAXVALS,STATUS)
 
268
C
 
269
      RETURN
 
270
      END
 
271
 
 
272
 
 
273
      SUBROUTINE STDWRD(NO,DESCR,VALUES,FELEM,MAXVALS,DUNIT,STATUS)
 
274
C
 
275
      IMPLICIT NONE
 
276
C
 
277
      INTEGER     NO
 
278
      CHARACTER*(*)   DESCR
 
279
      INTEGER     FELEM, MAXVALS
 
280
      DOUBLE PRECISION     VALUES(*)
 
281
      INTEGER     DUNIT
 
282
      INTEGER     STATUS
 
283
C
 
284
      CALL STSTR(1,DESCR)                          !STRIPPED_STRING
 
285
C 
 
286
      CALL STD11(NO,VALUES,FELEM,MAXVALS,STATUS)
 
287
C
 
288
      RETURN
 
289
      END
 
290
 
 
291
 
 
292
      SUBROUTINE STDWRH(NO,DESCR,VALUES,FELEM,MAXVALS,STATUS)
 
293
C
 
294
      IMPLICIT NONE
 
295
C
 
296
      INTEGER     NO
 
297
      CHARACTER*(*)   DESCR, VALUES
 
298
      INTEGER     FELEM, MAXVALS
 
299
      INTEGER     STATUS
 
300
C
 
301
      CALL STSTR(1,DESCR)                          !STRIPPED_STRING
 
302
      CALL STSTR(2,VALUES)           !STRIPPED_STRING (not too long)
 
303
C
 
304
      CALL STD12(NO,FELEM,MAXVALS,STATUS)
 
305
C
 
306
      RETURN
 
307
      END
 
308
 
 
309
 
 
310
      SUBROUTINE STDWRI(NO,DESCR,VALUES,FELEM,MAXVALS,DUNIT,STATUS)
 
311
C
 
312
      IMPLICIT NONE
 
313
C
 
314
      INTEGER     NO
 
315
      CHARACTER*(*)   DESCR
 
316
      INTEGER     FELEM, MAXVALS
 
317
      INTEGER     VALUES(*)
 
318
      INTEGER     DUNIT
 
319
      INTEGER     STATUS
 
320
C
 
321
      CALL STSTR(1,DESCR)                          !STRIPPED_STRING
 
322
C 
 
323
      CALL STD13(NO,VALUES,FELEM,MAXVALS,STATUS)
 
324
C
 
325
      RETURN
 
326
      END
 
327
 
 
328
 
 
329
      SUBROUTINE STDWRL(NO,DESCR,VALUES,FELEM,MAXVALS,DUNIT,STATUS)
 
330
C
 
331
      IMPLICIT NONE
 
332
C
 
333
      INTEGER     NO
 
334
      CHARACTER*(*)   DESCR
 
335
      INTEGER     FELEM, MAXVALS
 
336
      INTEGER     VALUES(*)
 
337
      INTEGER     DUNIT
 
338
      INTEGER     STATUS
 
339
C
 
340
      CALL STSTR(1,DESCR)                          !STRIPPED_STRING
 
341
C
 
342
      CALL STD14(NO,VALUES,FELEM,MAXVALS,STATUS)
 
343
C
 
344
      RETURN
 
345
      END
 
346
 
 
347
 
 
348
      SUBROUTINE STDWRR(NO,DESCR,VALUES,FELEM,MAXVALS,DUNIT,STATUS)
 
349
C
 
350
      IMPLICIT NONE
 
351
C
 
352
      INTEGER     NO
 
353
      CHARACTER*(*)   DESCR
 
354
      INTEGER     FELEM, MAXVALS
 
355
      REAL     VALUES(*)
 
356
      INTEGER     DUNIT
 
357
      INTEGER     STATUS
 
358
C
 
359
      CALL STSTR(1,DESCR)                          !STRIPPED_STRING
 
360
C
 
361
      CALL STD15(NO,VALUES,FELEM,MAXVALS,STATUS)
 
362
C
 
363
      RETURN
 
364
      END
 
365
 
 
366
      SUBROUTINE STDDEL(NO,DESCR,STATUS)
 
367
C
 
368
      IMPLICIT NONE
 
369
C
 
370
      INTEGER     NO
 
371
      CHARACTER*(*)   DESCR
 
372
      INTEGER     STATUS
 
373
C
 
374
      CALL STSTR(1,DESCR)                          !STRIPPED_STRING
 
375
C
 
376
      CALL STD16(NO,STATUS)
 
377
C
 
378
      RETURN
 
379
      END
 
380
 
 
381
      SUBROUTINE STDCOP(FROM,TO,MASK,DESCR,STATUS)
 
382
C
 
383
      IMPLICIT NONE
 
384
C
 
385
      INTEGER     FROM,TO,MASK
 
386
      CHARACTER*(*)   DESCR
 
387
      INTEGER     STATUS
 
388
C
 
389
      CALL STSTR(1,DESCR)                          !STRIPPED_STRING
 
390
C
 
391
      CALL STD17(FROM,TO,MASK,STATUS)
 
392
C
 
393
      RETURN
 
394
      END
 
395