Line data Source code
1 0 : subroutine RPFITS_READ_TABLE(lun, tcards, ii, endhdr, terr, ierr)
2 : *-----------------------------------------------------------------------
3 : * Read all RPFITS tables to the end of the header.
4 : *
5 : * Given:
6 : * LUN int Logical unit number of the RPFITS file.
7 : * TCARDS(32)*80
8 : * char Array of header cards containing tables.
9 : * II int Current index in array TCARDS, or -1 if only
10 : * the flag table (at the end of the data) is to
11 : * be read.
12 : *
13 : * Returned:
14 : * ENDHDR log TRUE if the end of header was encountered.
15 : * TERR*2 char Table for which non-zero status (ierr) was
16 : * encountered.
17 : * IERR int Status value:
18 : * 0: Success.
19 : * 1: Table contains too many entries.
20 : * 2: Fortran I/O error (with IOSTAT code in
21 : * rp_iostat).
22 : *
23 : * Original: Ray Norris 1988/09/29
24 : * $Id: rpfits_tables.f,v 1.13 2011/03/29 03:53:36 cal103 Exp $
25 : *-----------------------------------------------------------------------
26 : include 'rpfits.inc'
27 :
28 : logical endhdr, fg_only
29 : integer AT_READ, idx, ierr, ii, ichr(640), j, lun
30 : character keywrd*8, terr*2, tcards(32)*80
31 : *-----------------------------------------------------------------------
32 0 : idx = ABS(ii)
33 0 : fg_only = (ii.eq.-1)
34 :
35 0 : endhdr = .false.
36 0 : terr = ' '
37 0 : ierr = 0
38 0 : do while (.true.)
39 0 : if (ncard.lt.0) then
40 0 : card(-ncard) = tcards(idx)
41 0 : ncard = ncard - 1
42 : end if
43 :
44 0 : keywrd = tcards(idx)(1:8)
45 0 : if (keywrd.eq.'TABLE AN') then
46 0 : an_found = .true.
47 0 : call READAN (lun, tcards, idx, ierr)
48 0 : else if (keywrd.eq.'TABLE IF') then
49 0 : if_found = .true.
50 0 : call READIF (lun, tcards, idx, ierr)
51 0 : else if (keywrd.eq.'TABLE SU' .or.
52 : : keywrd.eq.'TABLE SX') then
53 0 : su_found = .true.
54 0 : call READSU (lun, tcards, idx, ierr)
55 0 : else if (keywrd.eq.'TABLE FG') then
56 0 : fg_found = .true.
57 0 : call READFG (lun, tcards, idx, ierr)
58 0 : else if (keywrd.eq.'TABLE MT') then
59 0 : mt_found = .true.
60 0 : call READMT (lun, tcards, idx, ierr)
61 0 : else if (keywrd.eq.'TABLE CU') then
62 0 : cu_found = .true.
63 0 : call READCU (lun, tcards, idx, ierr)
64 0 : else if (keywrd.eq.'END') then
65 0 : endhdr = .true.
66 0 : go to 999
67 : end if
68 :
69 0 : if (ierr.ne.0) then
70 0 : terr = keywrd(7:)
71 0 : go to 999
72 : end if
73 :
74 0 : if (fg_only) go to 999
75 :
76 0 : idx = idx + 1
77 0 : if (idx.gt.32) then
78 0 : rp_iostat = AT_READ (lun, ichr)
79 0 : if (rp_iostat.ne.0) go to 999
80 :
81 0 : write (tcards, '(32(20a4,:,/))') (ichr(j), j=1,640)
82 0 : idx = 1
83 : end if
84 : end do
85 :
86 0 : 999 if (rp_iostat.ne.0) ierr = 2
87 :
88 0 : end
89 :
90 :
91 :
92 0 : subroutine READAN (lun, tcards, idx, ierr)
93 : *-----------------------------------------------------------------------
94 : * Read an AN (antenna) table.
95 : *
96 : * Original: Ray Norris 1989/07/17
97 : *-----------------------------------------------------------------------
98 : include 'rpfits.inc'
99 :
100 : integer AT_READ, iaxis_offset, ichr(640), idx, ierr, j, jdx, k,
101 : : lun
102 : character keywrd*8, tcards(32)*80
103 : *-----------------------------------------------------------------------
104 0 : ierr = 0
105 0 : nant = 0
106 0 : do while (.true.)
107 0 : do jdx = idx+1, 32
108 0 : if (ncard.lt.0) then
109 0 : card(-ncard) = tcards(jdx)
110 0 : ncard = ncard - 1
111 : end if
112 :
113 0 : keywrd = tcards(jdx)(1:8)
114 0 : if (keywrd.eq.'ENDTABLE') then
115 0 : idx = jdx
116 0 : go to 999
117 0 : else if (keywrd.eq.'HEADER' ) then
118 : * Skip it.
119 0 : else if (keywrd.eq.'COMMENT') then
120 : * Skip it.
121 : else
122 0 : k = nant + 1
123 0 : if (k.gt.ant_max) then
124 0 : ierr = 1
125 0 : go to 999
126 : end if
127 :
128 : read (tcards(jdx), 100, iostat=rp_iostat, err=999)
129 0 : : ant_num(k), sta(k), ant_mount(k), x(k), y(k), z(k),
130 0 : : iaxis_offset
131 : 100 format (i2,1x,a8,i2,3f14.3,i5)
132 :
133 0 : axis_offset(k) = iaxis_offset/1000.0
134 :
135 0 : nant = k
136 : end if
137 : end do
138 :
139 0 : rp_iostat = AT_READ (lun, ichr)
140 0 : if (rp_iostat.ne.0) go to 999
141 :
142 0 : write (tcards, '(32(20a4,:,/))') (ichr(j), j=1,640)
143 0 : idx = 0
144 : end do
145 :
146 0 : 999 if (rp_iostat.ne.0) ierr = 2
147 :
148 0 : end
149 :
150 :
151 :
152 0 : subroutine WRITE_AN_TABLE (idx, tcards)
153 : *-----------------------------------------------------------------------
154 : * Write an AN (antenna) table.
155 : *
156 : * Original: Ray Norris 1989/09/29
157 : *-----------------------------------------------------------------------
158 : include 'rpfits.inc'
159 :
160 : integer iant, idx
161 : character tcards(*)*80
162 : *-----------------------------------------------------------------------
163 0 : idx = idx + 1
164 0 : tcards(idx) = 'TABLE AN'
165 0 : idx = idx + 1
166 : tcards(idx) = 'HEADER M X ' //
167 0 : : 'Y Z AXIS'
168 :
169 0 : do iant = 1, nant
170 0 : idx = idx + 1
171 0 : write (tcards(idx),100) ant_num(iant), sta(iant),
172 0 : : ant_mount(iant), x(iant), y(iant), z(iant),
173 0 : : nint(axis_offset(iant)*1000.0)
174 : 100 format (i2,1x,a8,i2,3f14.3,i5)
175 : end do
176 :
177 0 : idx = idx + 1
178 0 : tcards(idx) = 'ENDTABLE'
179 :
180 0 : end
181 :
182 :
183 :
184 0 : subroutine READIF (lun, tcards, idx, ierr)
185 : *-----------------------------------------------------------------------
186 : * Read an IF (intermediate frequency, i.e. spectral window) table.
187 : *
188 : * Original: Ray Norris 1988/09/29
189 : *-----------------------------------------------------------------------
190 : include 'rpfits.inc'
191 :
192 : integer AT_READ, ichr(640), idx, ierr, j, jdx, k, l, lun
193 : character keywrd*8, tcards(32)*80, temp*5
194 : *-----------------------------------------------------------------------
195 0 : ierr = 0
196 0 : n_if = 0
197 0 : do while (.true.)
198 0 : do jdx = idx+1, 32
199 0 : if (ncard.lt.0) then
200 0 : card(-ncard) = tcards(jdx)
201 0 : ncard = ncard - 1
202 : end if
203 :
204 0 : keywrd = tcards(jdx)(1:8)
205 0 : if (keywrd.eq.'ENDTABLE') then
206 0 : idx = jdx
207 0 : go to 999
208 0 : else if (keywrd.eq.'HEADER') then
209 : * Skip it.
210 0 : else if (keywrd.eq.'COMMENT') then
211 : * Skip it.
212 : else
213 0 : k = n_if + 1
214 0 : if (k.gt.max_if) then
215 0 : ierr = 1
216 0 : go to 999
217 : end if
218 :
219 : read (tcards(jdx), 100, iostat=rp_iostat, err=999)
220 0 : : if_num(k), if_freq(k), if_invert(k), if_bw(k),
221 0 : : if_nfreq(k), if_nstok(k), (if_cstok(l,k), l=1,4),
222 0 : : if_sampl(k), if_ref(k), temp
223 : 100 format (bn,i3,f16.3,i3,f17.3,i5,i3,1x,4a2,i2,f7.1,1x,a5)
224 :
225 0 : if (temp.eq.' ') then
226 0 : if_simul(k) = 1
227 0 : if_chain(k) = 1
228 : else
229 0 : read (temp, *, iostat=rp_iostat, err=999) if_simul(k),
230 0 : : if_chain(k)
231 :
232 0 : if (if_simul(k).eq.0) if_simul(k) = 1
233 0 : if (if_chain(k).eq.0) if_chain(k) = 1
234 : end if
235 :
236 0 : n_if = k
237 : end if
238 : end do
239 :
240 0 : rp_iostat = AT_READ (lun, ichr)
241 0 : if (rp_iostat.ne.0) go to 999
242 :
243 0 : write (tcards, '(32(20a4,:,/))') (ichr(j), j=1,640)
244 0 : idx = 0
245 : end do
246 :
247 0 : 999 if (rp_iostat.ne.0) ierr = 2
248 :
249 0 : end
250 :
251 :
252 :
253 0 : subroutine WRITE_IF_TABLE (idx, tcards)
254 : *-----------------------------------------------------------------------
255 : * Write an IF (intermediate frequency, i.e. spectral window) table.
256 : *
257 : * Original: Ray Norris 1988/09/29
258 : *-----------------------------------------------------------------------
259 : include 'rpfits.inc'
260 :
261 : integer idx, iif, l
262 : character tcards(*)*80
263 : *-----------------------------------------------------------------------
264 0 : idx = idx + 1
265 0 : tcards(idx) = 'TABLE IF'
266 0 : idx = idx + 1
267 : tcards(idx) = 'HEADER FREQ INVERT BW NCHAN ' //
268 0 : : 'NSTOK TYPE SAM REF SIM CHAIN'
269 :
270 0 : do iif = 1, n_if
271 0 : idx = idx + 1
272 0 : write (tcards(idx), 100) if_num(iif), if_freq(iif),
273 0 : : if_invert(iif), if_bw(iif), if_nfreq(iif), if_nstok(iif),
274 0 : : (if_cstok(l,iif), l=1,4), if_sampl(iif), if_ref(iif),
275 0 : : if_simul(iif), if_chain(iif)
276 : 100 format (i3,f16.3,i3,f17.3,i5,i3,1x,4a2,i2,f7.1,2i3)
277 : end do
278 :
279 0 : idx = idx + 1
280 0 : tcards(idx) = 'ENDTABLE'
281 :
282 0 : end
283 :
284 :
285 :
286 0 : subroutine READSU(lun, tcards, idx, ierr)
287 : *-----------------------------------------------------------------------
288 : * Read an SU (source) or SX (extended source) table.
289 : *
290 : * Original: Ray Norris 1988/11/08
291 : *-----------------------------------------------------------------------
292 : include 'rpfits.inc'
293 :
294 : double precision D2PI
295 : parameter (D2PI = 2d0 * 3.14159265358979323846d0)
296 :
297 : integer AT_READ, ichr(640), idx, ierr, j, jdx, k, lun
298 : character keywrd*8, su_fmt*40, tcards(32)*80
299 : *-----------------------------------------------------------------------
300 : * Are we reading an extended source table?
301 0 : if (tcards(idx)(7:8).eq.'SU') then
302 : * No.
303 0 : su_fmt = '(bn,i3, a16,2f13.9,1x,a4,2f12.9)'
304 : else
305 : * Yes.
306 0 : su_fmt = '(bn,i4,1x,a16,2f13.9,1x,a4,2f12.9)'
307 : endif
308 :
309 0 : ierr = 0
310 0 : n_su = 0
311 0 : do while (.true.)
312 0 : do jdx = idx+1, 32
313 0 : if (ncard.lt.0) then
314 0 : card(-ncard) = tcards(jdx)
315 0 : ncard = ncard-1
316 : end if
317 :
318 0 : keywrd = tcards(jdx)(1:8)
319 0 : if (keywrd.eq.'ENDTABLE') then
320 0 : idx = jdx
321 0 : go to 999
322 0 : else if (keywrd.eq.'HEADER') then
323 : * Skip it.
324 0 : else if (keywrd.eq.'COMMENT') then
325 : * Skip it.
326 : else
327 0 : k = n_su + 1
328 0 : if (k.gt.max_su) then
329 0 : ierr = 1
330 0 : go to 999
331 : end if
332 :
333 : read (tcards(jdx), su_fmt, iostat=rp_iostat, err=999)
334 0 : : su_num(k), su_name(k), su_ra(k), su_dec(k), su_cal(k),
335 0 : : su_rad(k), su_decd(k)
336 :
337 0 : if (su_ra(k).lt.0d0) then
338 0 : su_ra(k) = su_ra(k) + D2PI
339 : end if
340 0 : if (su_rad(k).lt.0d0) then
341 0 : su_rad(k) = su_rad(k) + D2PI
342 : end if
343 :
344 0 : su_pra(k) = su_ra(k)
345 0 : su_pdec(k) = su_dec(k)
346 :
347 0 : n_su = k
348 : end if
349 : end do
350 :
351 0 : rp_iostat = AT_READ (lun, ichr)
352 0 : if (rp_iostat.ne.0) go to 999
353 :
354 0 : write (tcards, '(32(20a4,:,/))') (ichr(j), j=1,640)
355 0 : idx = 0
356 : end do
357 :
358 0 : 999 if (rp_iostat.ne.0) ierr = 2
359 :
360 0 : end
361 :
362 :
363 :
364 0 : subroutine WRITE_SU_TABLE (idx, tcards)
365 : *-----------------------------------------------------------------------
366 : * Write an SU (source) or SX (extended source) table.
367 : *
368 : * Original: Ray Norris 1988/11/08
369 : *-----------------------------------------------------------------------
370 : include 'rpfits.inc'
371 :
372 : double precision D2PI
373 : parameter (D2PI = 2d0 * 3.14159265358979323846d0)
374 :
375 : integer idx, isu
376 : character su_fmt*40, tcards(*)*80
377 : *-----------------------------------------------------------------------
378 0 : idx = idx + 1
379 :
380 : * Need we write an extended source table?
381 0 : if (n_su.lt.1000) then
382 : * No.
383 0 : tcards(idx) = 'TABLE SU'
384 0 : idx = idx + 1
385 : tcards(idx) = 'HEADER NAME RA2000 DEC2000' //
386 0 : : ' CAL RA_DATE DEC_DATE'
387 0 : su_fmt = '(i3, a16,2f13.9,1x,a4,2f12.9)'
388 : else
389 : * Yes.
390 0 : tcards(idx) = 'TABLE SX'
391 0 : idx = idx + 1
392 : tcards(idx) = 'HEADER NAME RA2000 DEC2000' //
393 0 : : ' CAL RA_DATE DEC_DATE'
394 0 : su_fmt = '(i4,1x,a16,2f13.9,1x,a4,2f12.9)'
395 : endif
396 :
397 0 : do isu = 1, n_su
398 0 : if (su_ra(isu).lt.0d0) then
399 0 : su_ra(isu) = su_ra(isu) + D2PI
400 : end if
401 0 : if (su_rad(isu).lt.0d0) then
402 0 : su_rad(isu) = su_rad(isu) + D2PI
403 : end if
404 :
405 0 : idx = idx + 1
406 0 : write (tcards(idx), su_fmt) su_num(isu), su_name(isu),
407 0 : : su_ra(isu), su_dec(isu), su_cal(isu), su_rad(isu),
408 0 : : su_decd(isu)
409 : end do
410 :
411 0 : idx = idx + 1
412 0 : tcards(idx) = 'ENDTABLE'
413 :
414 0 : end
415 :
416 :
417 :
418 0 : subroutine READFG (lun, tcards, idx, ierr)
419 : *-----------------------------------------------------------------------
420 : * Read a FG (flag) table.
421 : *
422 : * Original: Ray Norris 1988/11/08
423 : *-----------------------------------------------------------------------
424 : include 'rpfits.inc'
425 :
426 : integer AT_READ, dummy, ichr(640), idx, ierr, j, jdx, k, lun
427 : character keywrd*8, tcards(32)*80
428 : *-----------------------------------------------------------------------
429 0 : ierr = 0
430 0 : n_fg = 0
431 0 : do while (.true.)
432 0 : do jdx = idx+1, 32
433 0 : if (ncard.lt.0) then
434 0 : card(-ncard) = tcards(jdx)
435 0 : ncard = ncard - 1
436 : end if
437 :
438 0 : keywrd = tcards(jdx)(1:8)
439 0 : if (keywrd.eq.'ENDTABLE') then
440 0 : idx = jdx
441 0 : go to 999
442 0 : else if (keywrd.eq.'HEADER' ) then
443 : * Skip it.
444 0 : else if (keywrd.eq.'COMMENT') then
445 : * Skip it.
446 : else
447 0 : k = n_su + 1
448 0 : if (k.gt.max_fg) then
449 0 : ierr = 1
450 0 : go to 999
451 : end if
452 :
453 0 : read (tcards(jdx), 100, iostat=rp_iostat, err=999) dummy,
454 0 : : fg_ant(1,k), fg_ant(2,k), fg_ut(1,k), fg_ut(2,k),
455 0 : : fg_if(1,k), fg_if(2,k), fg_chan(1,k), fg_chan(2,k),
456 0 : : fg_stok(1,k), fg_stok(2,k), fg_reason(k)
457 : 100 format (bn,i3,i2,i3,2f9.1,1x,2i3,i4,i5,2i2,a24)
458 :
459 0 : n_fg = k
460 : end if
461 : end do
462 :
463 0 : rp_iostat = AT_READ (lun, ichr)
464 0 : if (rp_iostat.ne.0) go to 999
465 :
466 0 : write (tcards, '(32(20a4,:,/))') (ichr(j), j=1,640)
467 0 : idx = 0
468 : end do
469 :
470 0 : 999 if (rp_iostat.ne.0) ierr = 2
471 :
472 0 : end
473 :
474 :
475 :
476 0 : subroutine WRITE_FG_TABLE (idx, tcards)
477 : *-----------------------------------------------------------------------
478 : * Write a FG (flag) table.
479 : *
480 : * Original: Ray Norris 1988/11/08
481 : *-----------------------------------------------------------------------
482 : include 'rpfits.inc'
483 :
484 : integer idx, ifg
485 : character tcards(*)*80
486 : *-----------------------------------------------------------------------
487 0 : idx = idx + 1
488 0 : tcards(idx) = 'TABLE FG'
489 0 : idx = idx + 1
490 : tcards(idx) = 'HEADER ANT UT IF CHAN STOK ' //
491 0 : : 'REASON'
492 :
493 0 : do ifg = 1, n_fg
494 0 : idx = idx + 1
495 0 : write (tcards(idx), 100) ifg, fg_ant(1,ifg), fg_ant(2,ifg),
496 0 : : fg_ut(1,ifg), fg_ut(2,ifg), fg_if(1,ifg), fg_if(2,ifg),
497 0 : : fg_chan(1,ifg), fg_chan(2,ifg), fg_stok(1,ifg),
498 0 : : fg_stok(2,ifg), fg_reason(ifg)
499 : 100 format (i3,i2,i3,2f9.1,1x,2i3,i4,i5,2i2,a24)
500 : end do
501 :
502 0 : idx = idx + 1
503 0 : tcards(idx) = 'ENDTABLE'
504 :
505 0 : end
506 :
507 :
508 :
509 0 : subroutine READMT (lun, tcards, idx, ierr)
510 : *-----------------------------------------------------------------------
511 : * Read an MT (meteorological) table.
512 : *
513 : * Original: Ray Norris 1989/10/11
514 : *-----------------------------------------------------------------------
515 : include 'rpfits.inc'
516 :
517 : integer AT_READ, ichr(640), idx, ierr, j, jdx, k, lun
518 : character keywrd*8, tcards(32)*80
519 : *-----------------------------------------------------------------------
520 0 : ierr = 0
521 0 : n_mt = 0
522 0 : do while (.true.)
523 0 : do jdx = idx+1, 32
524 0 : if (ncard.lt.0) then
525 0 : card(-ncard) = tcards(jdx)
526 0 : ncard = ncard - 1
527 : end if
528 :
529 0 : keywrd = tcards(jdx)(1:8)
530 0 : if (keywrd.eq.'ENDTABLE') then
531 0 : idx = jdx
532 0 : go to 999
533 0 : else if (keywrd.eq.'HEADER' ) then
534 : * Skip it.
535 0 : else if (keywrd.eq.'COMMENT') then
536 : * Skip it.
537 : else
538 0 : k = n_mt + 1
539 0 : if (k.gt.max_mt) then
540 0 : ierr = 1
541 0 : go to 999
542 : end if
543 :
544 : read (tcards(jdx), 100, iostat=rp_iostat, err=999)
545 0 : : mt_ant(k), mt_ut(k), mt_press(k), mt_temp(k),
546 0 : : mt_humid(k)
547 : 100 format (i2,f9.1,f7.1,2f6.1)
548 :
549 0 : n_mt = k
550 : end if
551 : end do
552 :
553 0 : rp_iostat = AT_READ (lun, ichr)
554 0 : if (rp_iostat.ne.0) go to 999
555 :
556 0 : write (tcards, '(32(20a4,:,/))') (ichr(j), j=1,640)
557 0 : idx = 0
558 : end do
559 :
560 0 : 999 if (rp_iostat.ne.0) ierr = 2
561 :
562 0 : end
563 :
564 :
565 :
566 0 : subroutine WRITE_MT_TABLE (idx, tcards)
567 : *-----------------------------------------------------------------------
568 : * Write an MT (meteorological) table.
569 : *
570 : * Original: Ray Norris 1989/10/11
571 : *-----------------------------------------------------------------------
572 : include 'rpfits.inc'
573 :
574 : integer idx, imt
575 : character tcards(32)*80
576 : *-----------------------------------------------------------------------
577 0 : idx = idx + 1
578 0 : tcards(idx) = 'TABLE MT'
579 0 : idx = idx + 1
580 0 : tcards(idx) = 'HEADER UT PRESS TEMP HUMID'
581 :
582 0 : do imt = 1, n_mt
583 0 : idx = idx + 1
584 0 : write (tcards(idx), 100) mt_ant(imt), mt_ut(imt),
585 0 : : mt_press(imt), mt_temp(imt), mt_humid(imt)
586 : 100 format (i2,f9.1,f7.1,2f6.1)
587 : end do
588 :
589 0 : idx = idx + 1
590 0 : tcards(idx) = 'ENDTABLE'
591 :
592 0 : end
593 :
594 :
595 :
596 0 : subroutine READCU (lun, tcards, idx, ierr)
597 : *-----------------------------------------------------------------------
598 : * Read a CU (uncalibration) table.
599 : *
600 : * Original: Ray Norris 1990/03/22
601 : *-----------------------------------------------------------------------
602 : include 'rpfits.inc'
603 :
604 : integer AT_READ, ichr(640), idx, ierr, j, jdx, k, lun
605 : character keywrd*8, tcards(32)*80
606 : *-----------------------------------------------------------------------
607 0 : ierr = 0
608 0 : n_cu = 0
609 0 : do while (.true.)
610 0 : do jdx = idx+1, 32
611 0 : if (ncard.lt.0) then
612 0 : card(-ncard) = tcards(jdx)
613 0 : ncard = ncard - 1
614 : end if
615 :
616 0 : keywrd = tcards(jdx)(1:8)
617 0 : if (keywrd.eq.'ENDTABLE') then
618 0 : idx = jdx
619 0 : go to 999
620 0 : else if (keywrd.eq.'HEADER' ) then
621 : * Skip it.
622 0 : else if (keywrd.eq.'COMMENT') then
623 : * Skip it.
624 : else
625 0 : k = n_cu + 1
626 0 : if (k.gt.max_cu) then
627 0 : ierr = 1
628 0 : go to 999
629 : end if
630 :
631 : read (tcards(jdx), 100, iostat=rp_iostat, err=999)
632 0 : : cu_ut(k), cu_ant(k), cu_if(k), cu_cal1(k), cu_cal2(k),
633 0 : : cu_ch1(k), cu_ch2(k)
634 : 100 format (bn,f8.1,i3,i4,f6.1,f7.1,2i5)
635 :
636 0 : n_cu = k
637 : end if
638 : end do
639 :
640 0 : rp_iostat = AT_READ (lun, ichr)
641 0 : if (rp_iostat.ne.0) go to 999
642 :
643 0 : write (tcards, '(32(20a4,:,/))') (ichr(j), j=1,640)
644 0 : idx = 0
645 : end do
646 :
647 0 : 999 if (rp_iostat.ne.0) ierr = 2
648 :
649 0 : end
650 :
651 :
652 :
653 0 : subroutine WRITE_CU_TABLE (idx, tcards)
654 : *-----------------------------------------------------------------------
655 : * Write a CU (uncalibration) table.
656 : *
657 : * Original: Ray Norris 1989/10/11
658 : *-----------------------------------------------------------------------
659 : include 'rpfits.inc'
660 :
661 : integer icu, idx
662 : character tcards(*)*80
663 : *-----------------------------------------------------------------------
664 0 : idx = idx + 1
665 0 : tcards(idx) = 'TABLE CU'
666 0 : idx = idx + 1
667 0 : tcards(idx) = 'HEADER ANT IF CALSTART CALSTOP CH1 CH2'
668 :
669 0 : do icu = 1, n_cu
670 0 : idx = idx + 1
671 0 : write (tcards(idx), 100) cu_ut(n_cu), cu_ant(n_cu),
672 0 : : cu_if(n_cu), cu_cal1(n_cu), cu_cal2(n_cu), cu_ch1(n_cu),
673 0 : : cu_ch2(n_cu)
674 : 100 format (f8.1,i3,i4,f6.1,f7.1,2i5)
675 : end do
676 :
677 0 : idx = idx + 1
678 0 : tcards(idx) = 'ENDTABLE'
679 :
680 0 : return
681 : end
|
